diff options
Diffstat (limited to 'tests/var.test')
| -rw-r--r-- | tests/var.test | 784 |
1 files changed, 780 insertions, 4 deletions
diff --git a/tests/var.test b/tests/var.test index 5300adc..405a4b8 100644 --- a/tests/var.test +++ b/tests/var.test @@ -269,10 +269,11 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a - testupvar 1 a {} vv namespace + testupvar 2 a {} vv namespace } p } + # Modified: that should create a global var according to the docs! list $test_ns_var::vv [set test_ns_var::vv 123] $a } -result {456 123 123} test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup { @@ -464,7 +465,7 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup { set six 666 namespace eval test_ns_var { variable five 5 six - lappend a $five + lappend ::a $five } lappend a $test_ns_var::five \ [set test_ns_var::six 6] [set test_ns_var::six] $six @@ -491,9 +492,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l set a "" namespace eval test_ns_var { variable eight 8 - lappend a $eight + lappend ::a $eight variable eight - lappend a $eight + lappend ::a $eight } set a } {8 8} @@ -1479,6 +1480,781 @@ test var-24.24 {array default unset: errors} -setup { } -returnCodes error -cleanup { unset -nocomplain ary } -result * -match glob + +# The const command +test var-25.1 {const: no argument} -body { + apply {{} { + const + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} +test var-25.2 {const: single argument} -body { + apply {{} { + const X + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} +test var-25.3 {const: two arguments (basic correct usage)} { + apply {{} { + set res [const X gorp] + return [list $res $X] + }} +} {{} gorp} +test var-25.4 {const: three arguments} -body { + apply {{} { + const X gorp foo + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} +test var-25.5 {const: four arguments} -body { + apply {{} { + const X gorp foo bar + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} + +test var-26.1 {const: unmodifiable by set} -body { + apply {{} { + const X 123 + set X gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.2 {const: unmodifiable by append} -body { + apply {{} { + const X 123 + append X gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.3 {const: unmodifiable by lappend} -body { + apply {{} { + const X 123 + lappend X gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.4 {const: unmodifiable by incr} -body { + apply {{} { + const X 123 + incr X + }} +} -returnCodes error -result {can't incr "X": variable is a constant} +test var-26.5 {const: unmodifiable by dict set} -body { + apply {{} { + const X {a 123} + dict set X a gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.6 {const: unmodifiable by regsub} -body { + apply {{} { + const X abcabc + regsub -all {a(.)} $X {\1\1} X + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.7 {const: unmodifiable by gets} -setup { + set file [makeFile foo var26.7.txt] + set f [open $file] +} -body { + apply {f { + const X abcabc + gets $f X + }} $f +} -returnCodes error -cleanup { + close $f + removeFile $file +} -result {can't set "X": variable is a constant} +test var-26.8 {const: may not be array} -body { + apply {{} { + array set X {a b} + const X 1 + return $X + }} +} -returnCodes error -result {can't make constant "X": variable is array} +test var-26.9.1 {const: may not be array element} -body { + apply {{} { + array set X {a b} + const X(a) 1 + return $X(a) + }} +} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array} +test var-26.9.2 {const: may not be array element} -body { + apply {{} { + array set X {a b} + const X(b) 1 + return $X(b) + }} +} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array} +test var-26.10.1 {const: unmodifiable by const but not an error} { + apply {{} { + const X 1 + const X 2 + return $X + }} +} 1 +test var-26.10.2 {const: unmodifiable by const but not an error} { + apply {{} { + lmap x {1 2 3} { + const A 2 + const B 3 + const C 5 + expr {$A * $x**2 + $B * $x + $C} + } + }} +} {10 19 32} +test var-26.11 {const: may not be unset} -body { + apply {{} { + const X 1 + unset X + }} +} -returnCodes error -result {can't unset "X": variable is a constant} +test var-26.12 {const: may not be unset, but -nocomplain doesn't complain} { + apply {{} { + const X 1 + unset -nocomplain X + return $X + }} +} 1 +test var-26.13 {const and traces: write trace causes fail} -body { + apply {{} { + trace add variable X write {apply {args { + error "ERR: $args" + }}} + const X gorp + return $X + }} +} -returnCodes error -result {can't set "X": ERR: X {} write} +test var-26.14 {const and traces: write trace err causes no const} -body { + apply {{} { + set trace {apply {args { + error "ERR: $args" + }}} + trace add variable X write $trace + catch { + const X gorp + } + trace remove variable X write $trace + set X 123 + return $X + }} +} -result 123 +test var-26.15 {const and traces: read traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {{} { + trace add variable X read {apply {args { + lappend ::traces $args + }}} + const X gorp + list $X $X $::traces + }} +} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup { + unset -nocomplain traces +} +test var-26.16 {const and traces: write traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {{} { + trace add variable X write {apply {args { + lappend ::traces $args + }}} + const X gorp + const X foo + catch {set X bar} + list $X $::traces + }} +} -result {gorp {{X {} write}}} -cleanup { + unset -nocomplain traces +} +test var-26.17 {const and traces: unset traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + list {*}[apply {{} { + trace add variable X unset {apply {args { + lappend ::traces $args + }}} + const X gorp + unset -nocomplain X + list $X $::traces + }}] $traces +} -result {gorp {} {{X {} unset}}} -cleanup { + unset -nocomplain traces +} + +# Same [const], but definitely not compiled +test var-27.1 {const: unmodifiable by set} -body { + apply {const { + $const X 123 + set X gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.2 {const: unmodifiable by append} -body { + apply {const { + $const X 123 + append X gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.3 {const: unmodifiable by lappend} -body { + apply {const { + $const X 123 + lappend X gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.4 {const: unmodifiable by incr} -body { + apply {const { + $const X 123 + incr X + }} const +} -returnCodes error -result {can't incr "X": variable is a constant} +test var-27.5 {const: unmodifiable by dict set} -body { + apply {const { + $const X {a 123} + dict set X a gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.6 {const: unmodifiable by regsub} -body { + apply {const { + $const X abcabc + regsub -all {a(.)} $X {\1\1} X + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.7 {const: unmodifiable by gets} -setup { + set file [makeFile foo var27.7.txt] + set f [open $file] +} -body { + apply {{const f} { + $const X abcabc + gets $f X + }} const $f +} -returnCodes error -cleanup { + close $f + removeFile $file +} -result {can't set "X": variable is a constant} +test var-27.8 {const: may not be array} -body { + apply {const { + array set X {a b} + $const X 1 + return $X + }} const +} -returnCodes error -result {can't make constant "X": variable is array} +test var-27.9.1 {const: may not be array element} -body { + apply {const { + array set X {a b} + $const X(a) 1 + return $X(a) + }} const +} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array} +test var-27.9.2 {const: may not be array element} -body { + apply {const { + array set X {a b} + $const X(b) 1 + return $X(b) + }} const +} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array} +test var-27.10.1 {const: unmodifiable by const but not an error} { + apply {const { + $const X 1 + $const X 2 + return $X + }} const +} 1 +test var-27.10.2 {const: unmodifiable by const but not an error} { + apply {const { + lmap x {1 2 3} { + $const A 2 + $const B 3 + $const C 5 + expr {$A * $x**2 + $B * $x + $C} + } + }} const +} {10 19 32} +test var-27.11 {const: may not be unset} -body { + apply {const { + $const X 1 + unset X + }} const +} -returnCodes error -result {can't unset "X": variable is a constant} +test var-27.12 {const: may not be unset, but -nocomplain doesn't complain} { + apply {const { + $const X 1 + unset -nocomplain X + return $X + }} const +} 1 +test var-27.13 {const and traces: write trace causes fail} -body { + apply {const { + trace add variable X write {apply {args { + error "ERR: $args" + }}} + $const X gorp + return $X + }} const +} -returnCodes error -result {can't set "X": ERR: X {} write} +test var-27.14 {const and traces: write trace err causes no const} -body { + apply {const { + set trace {apply {args { + error "ERR: $args" + }}} + trace add variable X write $trace + catch { + $const X gorp + } + trace remove variable X write $trace + set X 123 + return $X + }} const +} -result 123 +test var-27.15 {const and traces: read traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {const { + trace add variable X read {apply {args { + lappend ::traces $args + }}} + $const X gorp + list $X $X $::traces + }} const +} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup { + unset -nocomplain traces +} +test var-27.16 {const and traces: write traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {const { + trace add variable X write {apply {args { + lappend ::traces $args + }}} + $const X gorp + $const X foo + catch {set X bar} + list $X $::traces + }} const +} -result {gorp {{X {} write}}} -cleanup { + unset -nocomplain traces +} +test var-27.17 {const and traces: unset traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + list {*}[apply {const { + trace add variable X unset {apply {args { + lappend ::traces $args + }}} + $const X gorp + unset -nocomplain X + list $X $::traces + }} const] $traces +} -result {gorp {} {{X {} unset}}} -cleanup { + unset -nocomplain traces +} + +test var-28.1 {const: in a namespace} -setup { + namespace eval var28 {} +} -body { + namespace eval var28 { + variable X + const X gorp + return $X + } +} -cleanup { + namespace delete var28 +} -result gorp +test var-28.2 {const: in a namespace} -setup { + namespace eval var28 {} +} -body { + namespace eval var28 { + variable X + const X gorp + } + apply {{} { + variable X + set X 123 + } var28} +} -cleanup { + namespace delete var28 +} -returnCodes error -result {can't set "X": variable is a constant} +test var-28.3 {const: in a namespace} -setup { + namespace eval var28 {} +} -body { + namespace eval var28 { + variable X + const X gorp + } + apply {{} { + variable X + unset X + } var28} +} -cleanup { + namespace delete var28 +} -returnCodes error -result {can't unset "X": variable is a constant} +test var-28.4 {const: in a namespace} -setup { + namespace eval var28 {} +} -body { + namespace eval var28 { + variable X + const X gorp + } + namespace delete var28 + namespace eval var28 { + variable X abc + } + apply {{} { + variable X + return $X + } var28} +} -cleanup { + namespace delete var28 +} -result abc +test var-28.5 {const: in a namespace, direct access from proc} -setup { + namespace eval var28 {} +} -body { + set result [apply {{} { + const ::var28::X abc + # Constant in namespace, NOT locally! + info exists X + }}] + apply {res { + variable X + list $res [catch {unset X} msg] $msg $X + } var28} $result +} -cleanup { + namespace delete var28 +} -result {0 1 {can't unset "X": variable is a constant} abc} + +test var-29.1 {const: globally} -setup { + set int [interp create] +} -body { + $int eval { + const X gorp + apply {{} { + global X + return $X + }} + } +} -cleanup { + interp delete $int +} -result gorp +test var-29.2 {const: TclOO variable resolution} -setup { + oo::class create Parent +} -body { + oo::class create C { + superclass Parent + variable X + constructor {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + set c [C new] + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Parent destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.3 {const: TclOO variable resolution} -setup { + oo::class create Parent +} -body { + oo::class create C { + superclass Parent + private variable X + constructor {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + set c [C new] + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Parent destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.4 {const: TclOO variable resolution} -setup { + oo::class create Parent +} -body { + oo::class create C { + superclass Parent + variable X + constructor {} { + set X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + set X gorp + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + set c [C new] + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Parent destroy +} -result {123 {0 abc} {0 gorp} 0 {}} +test var-29.5 {const: TclOO variable resolution} -setup { + set c [oo::object create Instance] +} -body { + oo::objdefine $c { + variable X + method init {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + $c init + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Instance destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.6 {const: TclOO variable resolution} -setup { + set c [oo::object create Instance] +} -body { + oo::objdefine $c { + private variable X + method init {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + $c init + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Instance destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.7 {const: TclOO variable resolution} -setup { + set c [oo::object create Instance] +} -body { + oo::objdefine $c { + variable X + method init {} { + set X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + set X gorp + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + $c init + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Instance destroy +} -result {123 {0 abc} {0 gorp} 0 {}} + +# The info constant and info consts commands +test var-30.1 {info constant and info consts} { + apply {{} { + lappend consts [lsort [info consts]] [info constant X] + const X 1 + lappend consts [lsort [info consts]] [info constant X] + const Y 2 + lappend consts [lsort [info consts]] + const X 3 + lappend consts [lsort [info consts]] + }} +} {{} 0 X 1 {X Y} {X Y}} +test var-30.2 {info constant and info consts} { + apply {{} { + lappend consts [lsort [info consts X]] + const X 1 + lappend consts [lsort [info consts X]] + const Y 2 + lappend consts [lsort [info consts X]] + const X 3 + lappend consts [lsort [info consts X]] + }} +} {{} X X X} +test var-30.3 {info constant and info consts} { + apply {{} { + lappend consts [lsort [info consts ?]] + const X 1 + lappend consts [lsort [info consts ?]] + const Y 2 + lappend consts [lsort [info consts ?]] + const XX 3 + lappend consts [lsort [info consts ?]] + }} +} {{} X {X Y} {X Y}} +test var-30.4 {info constant and info consts} { + apply {{} { + lappend consts [lsort [info consts X]] + set X 1 + lappend consts [lsort [info consts X]] + set Y 2 + lappend consts [lsort [info consts X]] + set X 3 + lappend consts [lsort [info consts X]] + }} +} {{} {} {} {}} +test var-30.5 {info consts: in a namespace} -setup { + namespace eval var30 {} +} -body { + namespace eval var30 { + const X gorp + info consts + } +} -cleanup { + namespace delete var30 +} -result X +test var-30.6 {info consts: in a namespace} -setup { + namespace eval var30 {} +} -body { + namespace eval var30 { + const X gorp + variable Y foo + } + info consts var30::* +} -cleanup { + namespace delete var30 +} -result ::var30::X +test var-30.7 {info constant: bad constant names: array element} { + apply {{} { + info constant a(b) + }} +} 0 +test var-30.8 {info constant: bad constant names: array} { + apply {{} { + array set a {} + info constant a + }} +} 0 +test var-30.9 {info constant: bad constant names: no var} { + apply {{} { + info constant a + }} +} 0 +test var-30.10 {info constant: bad constant names: no namespace} { + apply {{} { + info constant ::var29::no::such::ns::a + }} +} 0 +test var-30.11 {info constant: bad constant names: dangling upvar} { + apply {{} { + upvar 0 no_var a + info constant a + }} +} 0 +test var-30.12 {info constant: bad constant names: bad name} { + apply {{} { + info constant a(b + }} +} 0 +test var-30.13 {info constant: bad constant names: nesting} { + apply {{} { + array set b {c d} + upvar 0 b(c) a + info constant a(d) + }} +} 0 + +test var-31.1 {info constant: syntax} -returnCodes error -body { + info constant +} -result {wrong # args: should be "info constant varName"} +test var-31.2 {info constant: syntax} -returnCodes error -body { + info constant foo bar +} -result {wrong # args: should be "info constant varName"} +test var-31.3 {info consts: syntax} -returnCodes error -body { + info consts foo bar +} -result {wrong # args: should be "info consts ?pattern?"} catch {namespace delete ns} catch {unset arr} |