diff options
Diffstat (limited to 'tests/set.test')
| -rw-r--r-- | tests/set.test | 95 |
1 files changed, 67 insertions, 28 deletions
diff --git a/tests/set.test b/tests/set.test index 736e0e5..18119f5 100644 --- a/tests/set.test +++ b/tests/set.test @@ -9,14 +9,17 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: set.test,v 1.5 1999/06/26 20:55:12 rjohnson Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import ::tcltest::* + package require tcltest 2 + namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + +testConstraint testset2 [llength [info commands testset2]] + catch {unset x} catch {unset i} @@ -190,9 +193,9 @@ test set-1.22 {TclCompileSetCmd: doing assignment, large int} { } 200000 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} { set i 25 - set i 000012345 ;# an octal literal == 5349 decimal + set i 0o00012345 ;# an octal literal == 5349 decimal list $i [incr i] -} {000012345 5350} +} {0o00012345 5350} test set-1.24 {TclCompileSetCmd: too many arguments} { set i 10 @@ -200,8 +203,41 @@ test set-1.24 {TclCompileSetCmd: too many arguments} { set msg } {wrong # args: should be "set varName ?newValue?"} +test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} { + # This was a known error in 8.1a* - 8.2.1 + catch {unset array} + set {array($foo)} 5 +} 5 +test set-1.26 {TclCompileSetCmd: various array constructs} { + # Test all kinds of array constructs that TclCompileSetCmd + # may feel inclined to tamper with. + proc p {} { + set a x + set be(hej) 1 ; # hej + set be($a) 1 ; # x + set {be($a)} 1 ; # $a + set be($a,hej) 1 ; # x,hej + set be($a,$a) 5 ; # x,x + set be(c($a) 1 ; # c(x + set be(\w\w) 1 ; # ww + set be(a:$a) [set be(x,$a)] ; # a:x + set be(hej,$be($a,hej),hej) 1 ; # hej,1,hej + set be([string range hugge 0 2]) 1 ; # hug + set be(a\ a) 1 ; # a a + set be($a\ ,[string range hugge 1 3],hej) 1 ; # x ,ugg,hej + set be($a,h"ej) 1 ; # x,h"ej + set be([string range "a b c" 2 end]) 1 ; # b c + 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} { - list [catch {set {"foo}} msg] $msg $errorInfo + unset -nocomplain {"foo} + list [catch {set {"foo}} msg] $msg $::errorInfo } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable while executing "set {"foo}"}} @@ -215,13 +251,14 @@ test set-2.3 {set command: runtime error, errors in reading variables} { 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} { +test set-2.4 {set command: runtime error, readonly variable} -body { proc readonly args {error "variable is read-only"} set x 123 trace var x w readonly - list [catch {set x 1} msg] $msg $errorInfo -} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only + list [catch {set x 1} msg] $msg $::errorInfo +} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing +* "set x 1"}} test set-2.5 {set command: runtime error, basic array operations} { list [catch {set a(other)} msg] $msg @@ -431,9 +468,9 @@ test set-3.22 {uncompiled set command: doing assignment, large int} { test set-3.23 {uncompiled set command: doing assignment, formatted int != int} { set z set $z i 25 - $z i 000012345 ;# an octal literal == 5349 decimal + $z i 0o00012345 ;# an octal literal == 5349 decimal list $i [incr i] -} {000012345 5350} +} {0o00012345 5350} test set-3.24 {uncompiled set command: too many arguments} { set z set @@ -443,8 +480,9 @@ test set-3.24 {uncompiled set command: too many arguments} { } {wrong # args: should be "set varName ?newValue?"} test set-4.1 {uncompiled set command: runtime error, bad variable name} { + unset -nocomplain {"foo} set z set - list [catch {$z {"foo}} msg] $msg $errorInfo + list [catch {$z {"foo}} msg] $msg $::errorInfo } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable while executing "$z {"foo}"}} @@ -460,14 +498,15 @@ test set-4.3 {uncompiled set command: runtime error, errors in reading variables $z a(6) 44 list [catch {$z a(18)} msg] $msg } {1 {can't read "a(18)": no such element in array}} -test set-4.4 {uncompiled set command: runtime error, readonly variable} { +test set-4.4 {uncompiled set command: runtime error, readonly variable} -body { set z set proc readonly args {error "variable is read-only"} $z x 123 trace var x w readonly - list [catch {$z x 1} msg] $msg $errorInfo -} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only + list [catch {$z x 1} msg] $msg $::errorInfo +} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing +* "$z x 1"}} test set-4.5 {uncompiled set command: runtime error, basic array operations} { set z set @@ -478,6 +517,18 @@ test set-4.6 {set command: runtime error, basic array operations} { list [catch {$z a} msg] $msg } {1 {can't read "a": variable is array}} +test set-5.1 {error on malformed array name} testset2 { + unset -nocomplain z + 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}} + +# 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} @@ -486,15 +537,3 @@ catch {unset x} catch {unset z} ::tcltest::cleanupTests return - - - - - - - - - - - - |