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