languages/tcl/t/tcl_var_subst.t

   1 #!perl
   2
   3 # Copyright (C) 2004-2007, The Perl Foundation.
   4 # $Id$
   5
   6 # the following lines re-execute this as a tcl script
   7 # the \ at the end of these lines makes them a comment in tcl \
   8 use lib qw(languages/tcl/lib tcl/lib lib ../lib ../../lib); # \
   9 use Tcl::Test; #\
  10 __DATA__
  11
  12 source lib/test_more.tcl
  13 plan 22
  14
  15 eval_is {
  16   catch {unset a}
  17   set a whee
  18   set b "foo $a bar"
  19 } {foo whee bar} {middle of ""}
  20
  21 eval_is {
  22   catch {unset a}
  23   set a whee
  24   set b "$a bar"
  25 } {whee bar} {beginning of ""}
  26
  27 eval_is {
  28   catch {unset a}
  29   set a whee
  30   set b "bar $a"
  31 } {bar whee} {end of ""}
  32
  33 eval_is {
  34   catch {unset a}
  35   set a whee
  36   set b $a
  37 } whee {entire word}
  38
  39 eval_is {
  40    catch {unset a}
  41    set a(b) whee
  42    set b $a(b)
  43 } whee {array, entire word}
  44
  45 eval_is {
  46   catch {unset a}
  47   set a 2
  48   set b $a(b)
  49 } {can't read "a(b)": variable isn't array} {try to use scalar as array}
  50
  51 eval_is {
  52   catch {unset a}
  53   set a(b) 2
  54   set b $a
  55 } {can't read "a": variable is array} {try to use array as scalar}
  56
  57 eval_is {
  58   catch {unset x}
  59   set x(0) 44
  60   set b ${x(0)}
  61 } 44 {${} substitute an array item}
  62
  63 eval_is {
  64   catch {unset x}
  65   set x foo
  66   set b $::x
  67 } foo {explicit global}
  68
  69 eval_is {
  70   namespace eval lib { variable version 0.1 }
  71   set b $::lib::version
  72 } 0.1 {absolute namespace var}
  73
  74 eval_is {
  75   catch {unset x}
  76   set ::x foo
  77   set b $x
  78 } foo {write to explicit global}
  79
  80 eval_is {
  81   namespace eval lib { variable version }
  82   set ::lib::version 0.1
  83   set b $::lib::version
  84 } 0.1 {write to absolute namespace var}
  85
  86 eval_is {
  87   catch {unset array}
  88   array set array {test ok}
  89   set key test
  90   set b $array($key)
  91 } ok {variable index into array}
  92
  93 eval_is {
  94   catch {unset bar}
  95   set b $foo($bar)
  96 } {can't read "bar": no such variable} {invalid variable as key}
  97
  98 eval_is {
  99   catch {unset foo}
 100   array set foo {$ ok}
 101   set b $foo($)
 102 } ok {single $ as index}
 103
 104 eval_is {
 105   catch {unset foo}
 106   array set foo {) ok}
 107   set key )
 108   set b $foo([set key])
 109 } ok {use ) as a key}
 110
 111 eval_is {
 112   catch {unset array}
 113   catch {unset foo}
 114   array set array {a 1 b 2 c 3}
 115   set foo b
 116   set b $array([set foo)
 117 } {missing close-bracket} {missing ] in subcommand as key}
 118
 119 eval_is {
 120   catch {unset array}
 121   catch {unset foo}
 122   array set array {a 1 b 2 c 3}
 123   set foo b
 124   set b $array([set foo]a)
 125 } {can't read "array(ba)": no such element in array} {invalid key}
 126
 127 eval_is {
 128   catch {unset array}
 129   array set array {a 1 b 2 c 3}
 130   set ) b
 131   set b $array([set )])
 132 } 2 {use literal ) inside the array key}
 133
 134 eval_is {
 135   catch {unset x}
 136   namespace eval foo {  proc bar {} { return ok }  }
 137   set x foo
 138   $x\::bar
 139 } ok {namespace variable with escaped colon}
 140
 141
 142 namespace eval foo {
 143     variable y 7
 144 }
 145 set x 5
 146 namespace eval test {
 147     is [set foo::y] 7 {foo::y relative}
 148     is [set x]      5 {x relative}
 149 }