summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/set-old.test4
-rw-r--r--tests/set.test113
-rw-r--r--tests/var.test46
3 files changed, 105 insertions, 58 deletions
diff --git a/tests/set-old.test b/tests/set-old.test
index 94b6901..1c68f91 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -14,7 +14,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -865,6 +865,8 @@ test set-old-10.13 {array enumeration errors} {
list [catch {array done a b c} msg] $msg
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
test set-old-10.14 {array enumeration errors} {
+ catch {unset a}
+ set a(a) a
list [catch {array done a b} msg] $msg
} {1 {illegal search identifier "b"}}
test set-old-10.15 {array enumeration errors} {
diff --git a/tests/set.test b/tests/set.test
index 18119f5..374ff7a 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -22,7 +22,7 @@ testConstraint testset2 [llength [info commands testset2]]
catch {unset x}
catch {unset i}
-
+
test set-1.1 {TclCompileSetCmd: missing variable name} {
list [catch {set} msg] $msg
} {1 {wrong # args: should be "set varName ?newValue?"}}
@@ -39,16 +39,18 @@ test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
set i 17
list [set "i"] $i
} {17 17}
-test set-1.5 {TclCompileSetCmd: simple variable name in braces} {
+test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup {
catch {unset {a simple var}}
+} -body {
set {a simple var} 27
list [set {a simple var}] ${a simple var}
-} {27 27}
-test set-1.6 {TclCompileSetCmd: simple array variable name} {
+} -result {27 27}
+test set-1.6 {TclCompileSetCmd: simple array variable name} -setup {
catch {unset a}
+} -body {
set a(foo) 37
list [set a(foo)] $a(foo)
-} {37 37}
+} -result {37 37}
test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
set x "i"
set i 77
@@ -149,22 +151,24 @@ test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
}
260locals
} {1234}
-test set-1.15 {TclCompileSetCmd: variable is array} {
+test set-1.15 {TclCompileSetCmd: variable is array} -setup {
catch {unset a}
+} -body {
set x 27
set x [set a(foo) 11]
catch {unset a}
set x
-} 11
-test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
+} -result 11
+test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup {
catch {unset a}
+} -body {
set i 5
set x 789
set a(foo5) 27
set x [set a(foo$i)]
catch {unset a}
set x
-} 27
+} -result 27
test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
set i 5
@@ -211,7 +215,7 @@ test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} {
test set-1.26 {TclCompileSetCmd: various array constructs} {
# Test all kinds of array constructs that TclCompileSetCmd
# may feel inclined to tamper with.
- proc p {} {
+ apply {{} {
set a x
set be(hej) 1 ; # hej
set be($a) 1 ; # x
@@ -230,28 +234,33 @@ test set-1.26 {TclCompileSetCmd: various array constructs} {
set [string range bet 0 1](foo) 1 ; # foo
set be([set be(a:$a)][set b\e($a)]) 1 ; # 51
return [lsort [array names be]]
- }
- p
+ }}
} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
{b c} foo 51}]; # " just a matching end quote
-test set-2.1 {set command: runtime error, bad variable name} {
+test set-2.1 {set command: runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
list [catch {set {"foo}} msg] $msg $::errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
while executing
"set {"foo}"}}
-test set-2.2 {set command: runtime error, not array variable} {
- catch {unset b}
+# Stop my editor highlighter " from being confused
+test set-2.2 {set command: runtime error, not array variable} -setup {
+ unset -nocomplain b
+} -body {
set b 44
list [catch {set b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-2.3 {set command: runtime error, errors in reading variables} {
- catch {unset a}
+} -result {1 {can't read "b(123)": variable isn't array}}
+test set-2.3 {set command: runtime error, errors in reading variables} -setup {
+ unset -nocomplain a
+} -body {
set a(6) 44
list [catch {set a(18)} msg] $msg
-} {1 {can't read "a(18)": no such element in array}}
-test set-2.4 {set command: runtime error, readonly variable} -body {
+} -result {1 {can't read "a(18)": no such element in array}}
+test set-2.4 {set command: runtime error, readonly variable} -setup {
+ unset -nocomplain x
+} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
@@ -260,12 +269,18 @@ test set-2.4 {set command: runtime error, readonly variable} -body {
while executing
*
"set x 1"}}
-test set-2.5 {set command: runtime error, basic array operations} {
+test set-2.5 {set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+} -body {
+ array set a {}
list [catch {set a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-2.6 {set command: runtime error, basic array operations} {
+} -result {1 {can't read "a(other)": no such element in array}}
+test set-2.6 {set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+} -body {
+ array set a {}
list [catch {set a} msg] $msg
-} {1 {can't read "a": variable is array}}
+} -result {1 {can't read "a": variable is array}}
# Test the uncompiled version of set
@@ -479,25 +494,29 @@ test set-3.24 {uncompiled set command: too many arguments} {
$z msg
} {wrong # args: should be "set varName ?newValue?"}
-test set-4.1 {uncompiled set command: runtime error, bad variable name} {
+test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
set z set
list [catch {$z {"foo}} msg] $msg $::errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
while executing
"$z {"foo}"}}
-test set-4.2 {uncompiled set command: runtime error, not array variable} {
- set z set
+# Stop my editor highlighter " from being confused
+test set-4.2 {uncompiled set command: runtime error, not array variable} -setup {
catch {unset b}
+} -body {
+ set z set
$z b 44
list [catch {$z b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-4.3 {uncompiled set command: runtime error, errors in reading variables} {
- set z set
- catch {unset a}
+} -result {1 {can't read "b(123)": variable isn't array}}
+test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup {
+ catch {unset a}
+} -body {
+ set z set
$z a(6) 44
list [catch {$z a(18)} msg] $msg
-} {1 {can't read "a(18)": no such element in array}}
+} -result {1 {can't read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
set z set
proc readonly args {error "variable is read-only"}
@@ -508,27 +527,33 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
while executing
*
"$z x 1"}}
-test set-4.5 {uncompiled set command: runtime error, basic array operations} {
+test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+ array set a {}
+} -body {
set z set
list [catch {$z a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-4.6 {set command: runtime error, basic array operations} {
+} -result {1 {can't read "a(other)": no such element in array}}
+test set-4.6 {set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+ array set a {}
+} -body {
set z set
list [catch {$z a} msg] $msg
-} {1 {can't read "a": variable is array}}
+} -result {1 {can't read "a": variable is array}}
-test set-5.1 {error on malformed array name} testset2 {
+test set-5.1 {error on malformed array name} -constraints testset2 -setup {
unset -nocomplain z
+} -body {
catch {testset2 z(a) b} msg
catch {testset2 z(b) a} msg1
list $msg $msg1
-} {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
-
+} -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
# In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
test set-5.2 {Bug 3602706} -body {
testset2 ::tcl_platform not-in-there
} -returnCodes error -result * -match glob
-
+
# cleanup
catch {unset a}
catch {unset b}
@@ -537,3 +562,7 @@ catch {unset x}
catch {unset z}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/var.test b/tests/var.test
index b6b09fd..690bd10 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -44,10 +44,12 @@ test var-1.1 {TclLookupVar, Array handling} -setup {
set arr(foo) 37
list [$x i] $i [$x arr(foo)] $arr(foo)
} -result {11 11 38 38}
+set ::x "global value"
+namespace eval test_ns_var {
+ variable x "namespace value"
+}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
- set x "global value"
namespace eval test_ns_var {
- variable x "namespace value"
proc p {} {
global x ;# specifies TCL_GLOBAL_ONLY to get global x
return $x
@@ -261,6 +263,7 @@ test var-3.7 {MakeUpvar, my var has ::s} -setup {
}
} -result {789789}
test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
+ upvar #0 aaaaa xxxxx
catch {unset aaaaa}
catch {unset xxxxx}
} -body {
@@ -274,6 +277,8 @@ test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
} -returnCodes error -body {
set aaaaa 789789
upvar #0 aaaaa test_ns_fred::lnk
+} -cleanup {
+ unset ::aaaaa
} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
test var-3.10 {MakeUpvar, between namespaces} -body {
namespace eval {} {
@@ -282,8 +287,6 @@ test var-3.10 {MakeUpvar, between namespaces} -body {
set foo::bar 1
list $bar $foo::bar
}
-} -cleanup {
- unset ::aaaaa
} -result {1 1}
test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
catch {unset aaaaa}
@@ -322,9 +325,11 @@ test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
namespace which -variable martha
}
} {::test_ns_var::martha}
-test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
+test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
+ namespace eval test_ns_var {variable martha}
+} -body {
namespace which -variable test_ns_var::martha
-} {::test_ns_var::martha}
+} -result {::test_ns_var::martha}
test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
namespace eval test_ns_var {
@@ -348,6 +353,7 @@ test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
test_ns_var::p
} {java}
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
+ namespace eval ::test_ns_var::test_ns_nested {}
set ::test_ns_var::test_ns_nested:: 24
apply {{} {
global ::test_ns_var::test_ns_nested::
@@ -389,20 +395,26 @@ test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
}
list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
} {0 1 {can't read "test_ns_var::two": no such variable}}
-test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
+test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
+ catch {namespace delete test_ns_var}
+ namespace eval test_ns_var {variable one 1}
+} -body {
namespace eval test_ns_var {
variable two 2
}
list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {set two}]
-} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
-test var-7.4 {Tcl_VariableObjCmd, list of vars} {
+} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
+test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
+ catch {namespace delete test_ns_var}
+ namespace eval test_ns_var {variable one 1; variable two 2}
+} -body {
namespace eval test_ns_var {
variable three 3 four 4
}
list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {expr $three+$four}]
-} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
+} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
catch {unset a}
catch {unset five}
@@ -476,7 +488,9 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
{1 {can't unset "test_ns_var2::z": no such variable}}\
{}]
-test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+ namespace eval test_ns_var { variable eight 8 }
+} -body {
namespace eval test_ns_var {
proc p {} {
variable eight
@@ -484,14 +498,16 @@ test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link v
}
p
}
-} {8 eight}
-test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+} -result {8 eight}
+test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+ namespace eval test_ns_var { variable eight 8 }
+} -body {
proc p {} { ;# note this proc is at global :: scope
variable test_ns_var::eight
list [set eight] [info vars]
}
p
-} {8 eight}
+} -result {8 eight}
test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
namespace eval test_ns_var {
variable {} {My name is empty}
@@ -774,7 +790,7 @@ test var-17.1 {TclArraySet [Bug 1669489]} -setup {
test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
set already 0
- unset x
+ unset -nocomplain x
} -body {
array set x {e 1 i 1}
trace add variable x unset {apply {args {
generated by cgit v0.12 at 2024-11-20 11:54:06 (GMT)