1#
2# Tests for classes within namespaces
3# ----------------------------------------------------------------------
4#   AUTHOR:  Michael J. McLennan
5#            Bell Labs Innovations for Lucent Technologies
6#            mmclennan@lucent.com
7#            http://www.tcltk.com/itcl
8#
9#      RCS:  $Id: namespace.test,v 1.5 2004/02/12 18:09:50 davygrvy Exp $
10# ----------------------------------------------------------------------
11#            Copyright (c) 1993-1998  Lucent Technologies, Inc.
12# ======================================================================
13# See the file "license.terms" for information on usage and
14# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest 2.1
18    namespace import -force ::tcltest::test
19}
20
21::tcltest::loadTestedCommands
22
23# ----------------------------------------------------------------------
24#  Classes within namespaces
25# ----------------------------------------------------------------------
26test namespace-1.1 {same class name can be used in different namespaces} {
27    namespace eval test_ns_1 {
28        itcl::class Counter {
29            variable num 0
30            method ++ {{by 1}} {
31                incr num $by
32            }
33            method do {args} {
34                return [eval $args]
35            }
36            common tag 1
37        }
38        proc exists {} { return "don't clobber me!" }
39    }
40    namespace eval test_ns_2 {
41        itcl::class Counter {
42            variable num 0
43            method ++ {{by 2}} {
44                if {$num == 0} {
45                    set num 1
46                } else {
47                    set num [expr $num*$by]
48                }
49            }
50            method do {args} {
51                return [eval $args]
52            }
53            common tag 2
54        }
55    }
56} ""
57
58test namespace-1.2 {classes in different namespaces are different} {
59    list [namespace eval test_ns_1::Counter {info variable tag}] \
60         [namespace eval test_ns_2::Counter {info variable tag}] \
61} {{protected common ::test_ns_1::Counter::tag 1 1} {protected common ::test_ns_2::Counter::tag 2 2}}
62
63test namespace-1.3 {create an object in one namespace} {
64    namespace eval test_ns_1 {
65        list [Counter c] [c ++] [c ++] [c ++] [c ++]
66    }
67} {c 1 2 3 4}
68
69test namespace-1.4 {create an object in another namespace} {
70    namespace eval test_ns_2 {
71        list [Counter c] [c ++] [c ++] [c ++] [c ++]
72    }
73} {c 1 2 4 8}
74
75test namespace-1.5 {can find classes wrapped in a namespace} {
76    list [catch {test_ns_1::c do itcl::find objects -isa Counter} msg] $msg \
77         [catch {test_ns_1::c do itcl::find objects -class Counter} msg] $msg
78} {0 ::test_ns_1::c 0 ::test_ns_1::c}
79
80test namespace-1.6 {can't create an object that clobbers a command in this namespace} {
81    list [catch {namespace eval test_ns_1 {Counter exists}} msg] $msg
82} {1 {command "exists" already exists in namespace "::test_ns_1"}}
83
84test namespace-1.7 {can create an object that shadows a command in the global namespace} {
85    list [catch {namespace eval test_ns_1 {Counter lreplace}} msg] $msg \
86         [catch {itcl::find objects *lreplace} msg] $msg \
87         [namespace eval test_ns_1 {namespace which lreplace}]
88} {0 lreplace 0 ::test_ns_1::lreplace ::test_ns_1::lreplace}
89
90namespace delete test_ns_1 test_ns_2
91
92::tcltest::cleanupTests
93return
94