Subversion Repositories or1k

#
# Tests for "local" command for creating objects local to a proc
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan
#            Bell Labs Innovations for Lucent Technologies
#            mmclennan@lucent.com
#            http://www.tcltk.com/itcl
#
#      RCS:  $Id: local.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.

if {[string compare test [info procs test]] == 1} then {source defs}

# ----------------------------------------------------------------------
#  Test "local" to create objects that only exist within a proc
# ----------------------------------------------------------------------
test local-1.1 {define a class to use for testing} {
    class test_local {
        common status ""
        constructor {} {
            lappend status "created $this"
        }
        destructor {
            lappend status "deleted $this"
        }
        proc clear {} {
            set status ""
        }
        proc check {} {
            return $status
        }
        proc test {} {
            local test_local #auto
            lappend status "processing"
        }
        proc test2 {} {
            local test_local #auto
            lappend status "call test..."
            test
            lappend status "...back"
        }
    }
    test_local #auto
} {test_local0}

test local-1.2 {} {
    test_local::clear
    test_local::test
    test_local::check
} {{created ::test_local::test_local1} processing {deleted ::test_local::test_local1}}

test local-1.3 {} {
    test_local::clear
    test_local::test2
    test_local::check
} {{created ::test_local::test_local2} {call test...} {created ::test_local::test_local3} processing {deleted ::test_local::test_local3} ...back {deleted ::test_local::test_local2}}

test local-1.4 {} {
    find objects -isa test_local
} {test_local0}

delete class test_local