local.test

linux 下的源代码分析阅读器 red hat公司新版

#
# Tests for "local" command for creating objects local to a proc
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan
#            Bell Labs Innovations for Lucent Technologies
#            [e-mail]
#            http://www.tcltk.com/itcl
#
#      RCS:  $Id: local.test 144 2003-02-05 10:56:26Z mdejong $
# ----------------------------------------------------------------------
#            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.

package require tcltest
namespace import -force ::tcltest::*

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

package require Itcl

# ----------------------------------------------------------------------
#  Test "local" to create objects that only exist within a proc
# ----------------------------------------------------------------------
test local-1.1 {define a class to use for testing} {
    itcl::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 {} {
            itcl::local test_local #auto
            lappend status "processing"
        }
        proc test2 {} {
            itcl::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 {} {
    itcl::find objects -isa test_local
} {test_local0}

itcl::delete class test_local

::tcltest::cleanupTests
return