diff options
Diffstat (limited to 'tests/set-old.test')
| -rw-r--r-- | tests/set-old.test | 75 |
1 files changed, 25 insertions, 50 deletions
diff --git a/tests/set-old.test b/tests/set-old.test index 3289ae8..09de97b 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -6,20 +6,20 @@ # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # -# Copyright © 1991-1993 The Regents of the University of California. -# Copyright © 1994-1997 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest namespace import -force ::tcltest::* } proc ignore args {} - + # Simple variable operations. catch {unset a} @@ -169,7 +169,7 @@ test set-old-5.4 {errors in reading variables} { test set-old-6.1 {creating array during write} { catch {unset a} - trace add var a {read write unset} ignore + trace var a rwu ignore list [catch {set a(14) 186} msg] $msg [array names a] } {0 186 14} test set-old-6.2 {errors in writing variables} { @@ -204,7 +204,7 @@ test set-old-7.2 {unset command} { list [catch {unset} msg] $msg } {0 {}} # Used to return: -#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName ...?"}} +#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName varName ...?"}} test set-old-7.3 {unset command} { catch {unset a} list [catch {unset a} msg] $msg @@ -315,10 +315,10 @@ test set-old-7.19 {unset command, both switches} { test set-old-8.1 {array command} { list [catch {array} msg] $msg -} {1 {wrong # args: should be "array subcommand ?arg ...?"}} +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}} test set-old-8.2 {array command} { list [catch {array a} msg] $msg -} {1 {wrong # args: should be "array anymore arrayName searchId"}} +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}} test set-old-8.3 {array command} { catch {unset a} list [catch {array anymore a b} msg] $msg @@ -340,7 +340,7 @@ test set-old-8.6 {array command} { catch {unset a} set a(22) 3 list [catch {array gorp a} msg] $msg -} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}} +} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}} test set-old-8.7 {array command, anymore option} { catch {unset a} list [catch {array anymore a x} msg] $msg @@ -390,7 +390,7 @@ test set-old-8.14 {array command, exists option, array doesn't exist yet but has } {0 0} test set-old-8.15 {array command, get option} { list [catch {array get} msg] $msg -} {1 {wrong # args: should be "array get arrayName ?pattern?"}} +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}} test set-old-8.16 {array command, get option} { list [catch {array get a b c} msg] $msg } {1 {wrong # args: should be "array get arrayName ?pattern?"}} @@ -407,7 +407,7 @@ test set-old-8.18 {array command, get option} { test set-old-8.19 {array command, get option (unset variable)} { catch {unset a} set a(x) 3 - trace add var a(y) write ignore + trace var a(y) w ignore array get a } {x 3} test set-old-8.20 {array command, get option, with pattern} { @@ -445,13 +445,13 @@ test set-old-8.24 {array command, names option} { test set-old-8.25 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; - trace add var a(xxx) write ignore + trace var a(xxx) w ignore list [catch {lsort [array names a]} msg] $msg } {0 {22 33}} test set-old-8.26 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; - trace add var a(xxx) write ignore + trace var a(xxx) w ignore set a(xxx) value list [catch {lsort [array names a]} msg] $msg } {0 {22 33 xxx}} @@ -579,7 +579,7 @@ test set-old-8.43 {array command, size option} { test set-old-8.44 {array command, size option} { catch {unset a} set a(22) 3; - trace add var a(33) {read write unset} ignore + trace var a(33) rwu ignore list [catch {array size a} msg] $msg } {0 1} test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { @@ -652,13 +652,6 @@ test set-old-8.52 {array command, array names -regexp on regexp pattern} { set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} -test set-old-8.52.1 {array command, array names -regexp, backrefs} { - catch {unset a} - set a(1*2) 1 - set a(12) 1 - set a(11) 1 - list [catch {lsort [array names a -regexp {^(.)\1}]} msg] $msg -} {0 11} test set-old-8.53 {array command, array names -regexp} { catch {unset a} set a(-glob) 1 @@ -681,26 +674,15 @@ test set-old-8.55 {array command, array names -glob} { list [catch {array names a -glob} msg] $msg } {0 -glob} test set-old-8.56 {array command, array statistics on a non-array} { - catch {unset a} - list [catch {array statistics a} msg] $msg + catch {unset a} + list [catch {array statistics a} msg] $msg } [list 1 "\"a\" isn't an array"] -test set-old-8.57 {array command, array get with trivial pattern} { - catch {unset a} - set a(x) 1 - set a(y) 2 - array get a x -} {x 1} -test set-old-8.58 {array command, array set with LVT and odd length literal} { - list [catch {apply {{} { - array set a {b c d} - }}} msg] $msg -} {1 {list must have an even number of elements}} test set-old-9.1 {ids for array enumeration} { catch {unset a} set a(a) 1 list [array star a] [array star a] [array done a s-1-a; array star a] \ - [array done a s-2-a; array do a s-3-a; array start a] + [array done a s-2-a; array d a s-3-a; array start a] } {s-1-a s-2-a s-3-a s-1-a} test set-old-9.2 {array enumeration} { catch {unset a} @@ -786,7 +768,7 @@ test set-old-9.10 {array enumeration: searches automatically stopped} { set a(a) 1 set x [array startsearch a] set y [array startsearch a] - trace add var a(b) read {} + trace var a(b) r {} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}} @@ -795,21 +777,21 @@ test set-old-9.11 {array enumeration: searches automatically stopped} { set a(a) 1 set x [array startsearch a] set y [array startsearch a] - trace add var a(a) read {} + trace var a(a) r {} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {0 a 0 a} test set-old-9.12 {array enumeration with traced undefined elements} { catch {unset a} set a(a) 1 - trace add var a(b) read {} + trace var a(b) r {} set x [array startsearch a] lsort [list [array next a $x] [array next a $x]] } {{} a} test set-old-10.1 {array enumeration errors} { list [catch {array start} msg] $msg -} {1 {wrong # args: should be "array startsearch arrayName"}} +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}} test set-old-10.2 {array enumeration errors} { list [catch {array start a b} msg] $msg } {1 {wrong # args: should be "array startsearch arrayName"}} @@ -872,8 +854,6 @@ 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} { @@ -929,19 +909,14 @@ test set-old-12.2 {cleanup on procedure return} { } foo } 23456 - + # Must delete variables when done, since these arrays get used as # scalars by other tests. catch {unset a} catch {unset b} catch {unset c} catch {unset aVaRnAmE} -catch {rename foo {}} # cleanup ::tcltest::cleanupTests -return - -# Local Variables: -# mode: tcl -# End: +return |