util/src/TclTk/tcl8.6.12/pkgs/itcl4.2.2/tests/namespace.test

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