Subversion Repositories or1k

#
# AAA - first test executed in test suite
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan
#            Bell Labs Innovations for Lucent Technologies
#            mmclennan@lucent.com
#            http://www.tcltk.com/itcl
#
#      RCS:  $Id: AAA.test,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1993-1998  Lucent Technologies, Inc.
# ======================================================================
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ----------------------------------------------------------------------
#  SHOULD HAVE A CLEAN SLATE
# ----------------------------------------------------------------------
test {No object info (no classes)} {
        itcl_info classes
} {
        $result == ""
}

test {No object info (no objects)} {
        itcl_info objects
} {
        $result == ""
}

# ----------------------------------------------------------------------
#  TEST CLASS AUTO-LOADING
# ----------------------------------------------------------------------
test {Force auto-loading through inheritance} {
        FooBar x
} {
        $result == "x"
}

test {Info: all classes} {
        itcl_info classes
} {
        [test_cmp_lists $result {Foo Bar FooBar}]
}

test {Info: all classes matching a pattern} {
        itcl_info classes *oo*
} {
        [test_cmp_lists $result {Foo FooBar}]
}

# ----------------------------------------------------------------------
#  OBJECT AUTO-NUMBERING
# ----------------------------------------------------------------------
test {Create object with auto-naming} {
        FooBar #auto -blit x
} {
        $result == "fooBar0" && [fooBar0 info public blit -value] == "x"
}

test {Create object with auto-naming} {
        FooBar #auto -blit y
} {
        $result == "fooBar1" && [fooBar1 info public blit -value] == "y"
}

test {Auto-naming should avoid names already in use} {
        FooBar fooBar2
        FooBar fooBar3
        FooBar fooBar4
        FooBar #auto
} {
        $result == "fooBar5"
}

test {Destroy all outstanding objects} {
        foreach obj [itcl_info objects] {
                $obj delete
        }
} {
        $result == ""
}