diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/dstring.test | 266 | ||||
| -rw-r--r-- | tests/init.test | 64 | ||||
| -rw-r--r-- | tests/link.test | 154 |
3 files changed, 312 insertions, 172 deletions
diff --git a/tests/dstring.test b/tests/dstring.test index 95321ec..bcc304d 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -1,42 +1,54 @@ # Commands covered: none # -# This file contains a collection of tests for Tcl's dynamic string -# library procedures. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for Tcl's dynamic string library +# procedures. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 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. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest namespace import -force ::tcltest::* } testConstraint testdstring [llength [info commands testdstring]] - -test dstring-1.1 {appending and retrieving} testdstring { +if {[testConstraint testdstring]} { + testdstring free +} + +test dstring-1.1 {appending and retrieving} -constraints testdstring -setup { testdstring free +} -body { testdstring append "abc" -1 list [testdstring get] [testdstring length] -} {abc 3} -test dstring-1.2 {appending and retrieving} testdstring { +} -cleanup { + testdstring free +} -result {abc 3} +test dstring-1.2 {appending and retrieving} -constraints testdstring -setup { testdstring free +} -body { testdstring append "abc" -1 testdstring append " xyzzy" 3 testdstring append " 12345" -1 list [testdstring get] [testdstring length] -} {{abc xy 12345} 12} -test dstring-1.3 {appending and retrieving} testdstring { +} -cleanup { + testdstring free +} -result {{abc xy 12345} 12} +test dstring-1.3 {appending and retrieving} -constraints testdstring -setup { testdstring free +} -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 } list [testdstring get] [testdstring length] -} {{aaaaaaaaaaaaaaaaaaaaa +} -cleanup { + testdstring free +} -result {{aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd @@ -54,101 +66,143 @@ ooooooooooooooooooooo ppppppppppppppppppppp } 352} -test dstring-2.1 {appending list elements} testdstring { +test dstring-2.1 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring element "abc" testdstring element "d e f" list [testdstring get] [testdstring length] -} {{abc {d e f}} 11} -test dstring-2.2 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result {{abc {d e f}} 11} +test dstring-2.2 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring element "x" testdstring element "\{" testdstring element "ab\}" testdstring get -} {x \{ ab\}} -test dstring-2.3 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result {x \{ ab\}} +test dstring-2.3 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l } testdstring get -} {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp} -test dstring-2.4 {appending list elements} testdstring { +} -cleanup { testdstring free +} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp} +test dstring-2.4 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { testdstring append "a\{" -1 testdstring element abc testdstring append " \{" -1 testdstring element xyzzy testdstring get -} "a{ abc {xyzzy" -test dstring-2.5 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result "a{ abc {xyzzy" +test dstring-2.5 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append " \{" -1 testdstring element abc testdstring get -} " {abc" -test dstring-2.6 {appending list elements} testdstring { +} -cleanup { testdstring free +} -result " {abc" +test dstring-2.6 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { testdstring append " " -1 testdstring element abc testdstring get -} { abc} -test dstring-2.7 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result { abc} +test dstring-2.7 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append "\\ " -1 testdstring element abc testdstring get -} "\\ abc" -test dstring-2.8 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result "\\ abc" +test dstring-2.8 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append "x " -1 testdstring element abc testdstring get -} {x abc} -test dstring-2.9 {appending list elements} testdstring { +} -cleanup { testdstring free +} -result {x abc} +test dstring-2.9 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { testdstring element # testdstring get -} {{#}} -test dstring-2.10 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result {{#}} +test dstring-2.10 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append " " -1 testdstring element # testdstring get -} { {#}} -test dstring-2.11 {appending list elements} testdstring { +} -cleanup { testdstring free +} -result { {#}} +test dstring-2.11 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { testdstring append \t -1 testdstring element # testdstring get -} \t{#} -test dstring-2.12 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result \t{#} +test dstring-2.12 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append x -1 testdstring element # testdstring get -} {x #} -test dstring-2.13 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result {x #} +test dstring-2.13 {appending list elements} -constraints testdstring -body { # This test shows lack of sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring free testdstring append "x " -1 testdstring element # testdstring get -} {x {#}} +} -cleanup { + testdstring free +} -result {x {#}} -test dstring-3.1 {nested sublists} testdstring { +test dstring-3.1 {nested sublists} -constraints testdstring -setup { testdstring free +} -body { testdstring start testdstring element foo testdstring element bar testdstring end testdstring element another testdstring get -} {{foo bar} another} -test dstring-3.2 {nested sublists} testdstring { +} -cleanup { + testdstring free +} -result {{foo bar} another} +test dstring-3.2 {nested sublists} -constraints testdstring -setup { testdstring free +} -body { testdstring start testdstring start testdstring element abc @@ -157,9 +211,12 @@ test dstring-3.2 {nested sublists} testdstring { testdstring end testdstring element ghi testdstring get -} {{{abc def}} ghi} -test dstring-3.3 {nested sublists} testdstring { +} -cleanup { testdstring free +} -result {{{abc def}} ghi} +test dstring-3.3 {nested sublists} -constraints testdstring -setup { + testdstring free +} -body { testdstring start testdstring start testdstring start @@ -171,9 +228,12 @@ test dstring-3.3 {nested sublists} testdstring { testdstring end testdstring element foo4 testdstring get -} {{{{foo foo2}} foo3} foo4} -test dstring-3.4 {nested sublists} testdstring { +} -cleanup { + testdstring free +} -result {{{{foo foo2}} foo3} foo4} +test dstring-3.4 {nested sublists} -constraints testdstring -setup { testdstring free +} -body { testdstring element before testdstring start testdstring element during @@ -181,52 +241,69 @@ test dstring-3.4 {nested sublists} testdstring { testdstring end testdstring element last testdstring get -} {before {during more} last} -test dstring-3.5 {nested sublists} testdstring { +} -cleanup { + testdstring free +} -result {before {during more} last} +test dstring-3.5 {nested sublists} -constraints testdstring -setup { testdstring free +} -body { testdstring element "\{" testdstring start testdstring element first testdstring element second testdstring end testdstring get -} {\{ {first second}} -test dstring-3.6 {appending list elements} testdstring { +} -cleanup { testdstring free +} -result {\{ {first second}} +test dstring-3.6 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { testdstring append x -1 testdstring start testdstring element # testdstring end testdstring get -} {x {{#}}} -test dstring-3.7 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result {x {{#}}} +test dstring-3.7 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append x -1 testdstring start testdstring append " " -1 testdstring element # testdstring end testdstring get -} {x { {#}}} -test dstring-3.8 {appending list elements} testdstring { +} -cleanup { testdstring free +} -result {x { {#}}} +test dstring-3.8 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { testdstring append x -1 testdstring start testdstring append \t -1 testdstring element # testdstring end testdstring get -} "x {\t{#}}" -test dstring-3.9 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result "x {\t{#}}" +test dstring-3.9 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { testdstring append x -1 testdstring start testdstring append x -1 testdstring element # testdstring end testdstring get -} {x {x #}} -test dstring-3.10 {appending list elements} testdstring { +} -cleanup { + testdstring free +} -result {x {x #}} +test dstring-3.10 {appending list elements} -constraints testdstring -body { # This test shows lack of sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring free @@ -236,36 +313,50 @@ test dstring-3.10 {appending list elements} testdstring { testdstring element # testdstring end testdstring get -} {x {x {#}}} +} -cleanup { + testdstring free +} -result {x {x {#}}} -test dstring-4.1 {truncation} testdstring { +test dstring-4.1 {truncation} -constraints testdstring -setup { testdstring free +} -body { testdstring append "abcdefg" -1 testdstring trunc 3 list [testdstring get] [testdstring length] -} {abc 3} -test dstring-4.2 {truncation} testdstring { +} -cleanup { + testdstring free +} -result {abc 3} +test dstring-4.2 {truncation} -constraints testdstring -setup { testdstring free +} -body { testdstring append "xyzzy" -1 testdstring trunc 0 list [testdstring get] [testdstring length] -} {{} 0} +} -cleanup { + testdstring free +} -result {{} 0} -test dstring-5.1 {copying to result} testdstring { +test dstring-5.1 {copying to result} -constraints testdstring -setup { testdstring free +} -body { testdstring append xyz -1 testdstring result -} xyz -test dstring-5.2 {copying to result} testdstring { +} -cleanup { + testdstring free +} -result xyz +test dstring-5.2 {copying to result} -constraints testdstring -setup { testdstring free - catch {unset a} + unset -nocomplain a +} -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 } set a [testdstring result] testdstring append abc -1 list $a [testdstring get] -} {{aaaaaaaaaaaaaaaaaaaaa +} -cleanup { + testdstring free +} -result {{aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd @@ -283,23 +374,31 @@ ooooooooooooooooooooo ppppppppppppppppppppp } abc} -test dstring-6.1 {Tcl_DStringGetResult} testdstring { +test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup { testdstring free +} -body { list [testdstring gresult staticsmall] [testdstring get] -} {{} short} -test dstring-6.2 {Tcl_DStringGetResult} testdstring { +} -cleanup { testdstring free +} -result {{} short} +test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup { + testdstring free +} -body { foreach l {a b c d e f g h i j k l m n o p} { testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 } list [testdstring gresult staticsmall] [testdstring get] -} {{} short} -test dstring-6.3 {Tcl_DStringGetResult} testdstring { +} -cleanup { + testdstring free +} -result {{} short} +test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body { set result {} lappend result [testdstring gresult staticlarge] testdstring append x 1 lappend result [testdstring get] -} {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9 +} -cleanup { + testdstring free +} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9 second0 second1 second2 second3 second4 second5 second6 second7 second8 second9 third0 third1 third2 third3 third4 third5 third6 third7 third8 third9 fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9 @@ -307,22 +406,31 @@ fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9 sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9 seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9 x}} -test dstring-6.4 {Tcl_DStringGetResult} testdstring { +test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body { set result {} lappend result [testdstring gresult free] testdstring append y 1 lappend result [testdstring get] -} {{} {This is a malloc-ed stringy}} -test dstring-6.5 {Tcl_DStringGetResult} testdstring { +} -cleanup { + testdstring free +} -result {{} {This is a malloc-ed stringy}} +test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body { set result {} lappend result [testdstring gresult special] testdstring append z 1 lappend result [testdstring get] -} {{} {This is a specially-allocated stringz}} - +} -cleanup { + testdstring free +} -result {{} {This is a specially-allocated stringz}} + # cleanup if {[testConstraint testdstring]} { testdstring free } ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/init.test b/tests/init.test index 6b61c06..40fa507 100644 --- a/tests/init.test +++ b/tests/init.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } @@ -45,33 +45,37 @@ test init-1.7 {auto_qualify - multiples colons 1} { test init-1.8 {auto_qualify - multiple colons 2} { auto_qualify :::foo ::bar } foo - + # We use a sub-interp and auto_reset and double the tests because there is 2 # places where auto_loading occur (before loading the indexes files and after) set testInterp [interp create] interp eval $testInterp [list set argv $argv] -interp eval $testInterp [list package require tcltest] -interp eval $testInterp [list namespace import -force ::tcltest::*] - +interp eval $testInterp { + package require tcltest 2 + namespace import -force ::tcltest::* + customMatch pairwise {apply {{mode pair} { + if {[llength $pair] != 2} {error "need a pair of values to check"} + string $mode [lindex $pair 0] [lindex $pair 1] + }}} +} +# TODO: Connect result reporting to master interp interp eval $testInterp { auto_reset catch {rename parray {}} - -test init-2.0 {load parray - stage 1} { - set ret [catch {parray} error] + +test init-2.0 {load parray - stage 1} -body { + parray +} -returnCodes error -cleanup { rename parray {} ;# remove it, for the next test - that should not fail. - list $ret $error -} {1 {wrong # args: should be "parray a ?pattern?"}} -test init-2.1 {load parray - stage 2} { - set ret [catch {parray} error] - list $ret $error -} {1 {wrong # args: should be "parray a ?pattern?"}} +} -result {wrong # args: should be "parray a ?pattern?"} +test init-2.1 {load parray - stage 2} -body { + parray +} -returnCodes error -result {wrong # args: should be "parray a ?pattern?"} auto_reset catch {rename ::safe::setLogCmd {}} -#unset auto_index(::safe::setLogCmd) -#unset auto_oldpath +#unset -nocomplain auto_index(::safe::setLogCmd) auto_oldpath test init-2.2 {load ::safe::setLogCmd - stage 1} { ::safe::setLogCmd rename ::safe::setLogCmd {} ;# should not fail @@ -105,18 +109,18 @@ test init-2.8 {load tcl::HistAdd} -setup { catch {rename ::tcl::HistAdd {}} } -body { # 3 ':' on purpose - list [catch {tcl:::HistAdd} error] $error -} -cleanup { + tcl:::HistAdd +} -returnCodes error -cleanup { rename ::tcl::HistAdd {} -} -result {1 {wrong # args: should be "tcl:::HistAdd event ?exec?"}} - +} -result {wrong # args: should be "tcl:::HistAdd event ?exec?"} + test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { namespace eval foo {namespace eval bar {proc blah {} {return 1}}} } foo:::bar::blah } 1 - + # Tests that compare the error stack trace generated when autoloading with # that generated when no autoloading is necessary. Ideally they should be the # same. @@ -145,29 +149,29 @@ foreach arg [subst -nocommands -novariables { {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} }] { - test init-4.$count.0 {::errorInfo produced by [unknown]} { + test init-4.$count.0 {::errorInfo produced by [unknown]} -setup { auto_reset + } -body { catch {parray a b $arg} set first $::errorInfo catch {parray a b $arg} - set second $::errorInfo - string equal $first $second - } 1 - test init-4.$count.1 {::errorInfo produced by [unknown]} { + list $first $::errorInfo + } -match pairwise -result equal + test init-4.$count.1 {::errorInfo produced by [unknown]} -setup { auto_reset + } -body { namespace eval junk [list array set $arg [list 1 2 3 4]] trace variable ::junk::$arg r \ "[list error [subst {Variable \"$arg\" is write-only}]] ;# " catch {parray ::junk::$arg} set first $::errorInfo catch {parray ::junk::$arg} - set second $::errorInfo - string equal $first $second - } 1 + list $first $::errorInfo + } -match pairwise -result equal incr count } - + test init-5.0 {return options passed through ::unknown} -setup { catch {rename xxx {}} set ::auto_index(::xxx) {proc ::xxx {} { diff --git a/tests/link.test b/tests/link.test index 3b423ec..60d0799 100644 --- a/tests/link.test +++ b/tests/link.test @@ -1,17 +1,17 @@ # Commands covered: none # -# This file contains a collection of tests for Tcl_LinkVar and related -# library procedures. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for Tcl_LinkVar and related library +# procedures. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 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. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } @@ -19,23 +19,27 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint testlink [llength [info commands testlink]] foreach i {int real bool string} { - catch {unset $i} + unset -nocomplain $i } -test link-1.1 {reading C variables from Tcl} {testlink} { + +test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup { testlink delete +} -body { testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list $int $real $bool $string $wide -} {43 1.23 1 NULL 12341234} -test link-1.2 {reading C variables from Tcl} {testlink} { +} -result {43 1.23 1 NULL 12341234} +test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup { testlink delete +} -body { testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -3 2 0 "A long string with spaces" 43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 list $int $real $bool $string $wide $int $real $bool $string $wide -} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321} +} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321} -test link-2.1 {writing C variables from Tcl} {testlink} { +test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup { testlink delete +} -body { testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 set int "0o0721" @@ -53,34 +57,39 @@ test link-2.1 {writing C variables from Tcl} {testlink} { set float 1.0987654321 set uwide 357357357357 concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide -} {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357} -test link-2.2 {writing bad values into variables} {testlink} { +} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357} +test link-2.2 {writing bad values into variables} -setup { testlink delete +} -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set int 09a} msg] $msg $int -} {1 {can't set "int": variable must have integer value} 43} -test link-2.3 {writing bad values into variables} {testlink} { +} -result {1 {can't set "int": variable must have integer value} 43} +test link-2.3 {writing bad values into variables} -setup { testlink delete +} -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set real 1.x3} msg] $msg $real -} {1 {can't set "real": variable must have real value} 1.23} -test link-2.4 {writing bad values into variables} {testlink} { +} -result {1 {can't set "real": variable must have real value} 1.23} +test link-2.4 {writing bad values into variables} -setup { testlink delete +} -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set bool gorp} msg] $msg $bool -} {1 {can't set "bool": variable must have boolean value} 1} -test link-2.5 {writing bad values into variables} {testlink} { +} -result {1 {can't set "bool": variable must have boolean value} 1} +test link-2.5 {writing bad values into variables} -setup { testlink delete +} -constraints {testlink} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list [catch {set wide gorp} msg] $msg $bool -} {1 {can't set "wide": variable must have integer value} 1} +} -result {1 {can't set "wide": variable must have integer value} 1} -test link-3.1 {read-only variables} {testlink} { +test link-3.1 {read-only variables} -constraints {testlink} -setup { testlink delete +} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0 list [catch {set int 4} msg] $msg $int \ @@ -88,9 +97,10 @@ test link-3.1 {read-only variables} {testlink} { [catch {set bool no} msg] $msg $bool \ [catch {set string "new value"} msg] $msg $string \ [catch {set wide 12341234} msg] $msg $wide -} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678} -test link-3.2 {read-only variables} {testlink} { +} -result {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678} +test link-3.2 {read-only variables} -constraints {testlink} -setup { testlink delete +} -body { testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0 list [catch {set int 4} msg] $msg $int \ @@ -98,19 +108,21 @@ test link-3.2 {read-only variables} {testlink} { [catch {set bool no} msg] $msg $bool \ [catch {set string "new value"} msg] $msg $string\ [catch {set wide 12341234} msg] $msg $wide -} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234} +} -result {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234} -test link-4.1 {unsetting linked variables} {testlink} { +test link-4.1 {unsetting linked variables} -constraints {testlink} -setup { testlink delete +} -body { testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 unset int real bool string wide list [catch {set int} msg] $msg [catch {set real} msg] $msg \ [catch {set bool} msg] $msg [catch {set string} msg] $msg \ [catch {set wide} msg] $msg -} {0 -6 0 -2.5 0 0 0 stringValue 0 13579} -test link-4.2 {unsetting linked variables} {testlink} { +} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579} +test link-4.2 {unsetting linked variables} -constraints {testlink} -setup { testlink delete +} -body { testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 unset int real bool string wide @@ -120,10 +132,11 @@ test link-4.2 {unsetting linked variables} {testlink} { set string newValue set wide 333555 lrange [testlink get] 0 4 -} {102 16.0 1 newValue 333555} +} -result {102 16.0 1 newValue 333555} -test link-5.1 {unlinking variables} {testlink} { +test link-5.1 {unlinking variables} -constraints {testlink} -setup { testlink delete +} -body { testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink delete set int xx1 @@ -141,98 +154,108 @@ test link-5.1 {unlinking variables} {testlink} { set float dskjfbjfd set uwide isdfsngs testlink get -} {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234} -test link-5.2 {unlinking variables} {testlink} { +} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234} +test link-5.2 {unlinking variables} -constraints {testlink} -setup { testlink delete +} -body { testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink delete testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide -} {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234} +} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234} -test link-6.1 {errors in setting up link} {testlink} { +test link-6.1 {errors in setting up link} -setup { testlink delete - catch {unset int} + unset -nocomplain int +} -constraints {testlink} -body { set int(44) 1 - list [catch {testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1} msg] $msg -} {1 {can't set "int": variable is array}} -catch {unset int} + testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +} -cleanup { + unset -nocomplain int +} -returnCodes error -result {can't set "int": variable is array} -test link-7.1 {access to linked variables via upvar} {testlink} { +test link-7.1 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar int y unset y } - testlink delete testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0 testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {} x list [catch {set int} msg] $msg -} {0 14} -test link-7.2 {access to linked variables via upvar} {testlink} { +} -result {0 14} +test link-7.2 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar int y return [set y] } - testlink delete testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0 testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {} set int testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {} x list [x] $int -} {23 23} -test link-7.3 {access to linked variables via upvar} {testlink} { +} -result {23 23} +test link-7.3 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar int y set y 44 } - testlink delete testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0 testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $int -} {1 {can't set "y": linked variable is read-only} 11} -test link-7.4 {access to linked variables via upvar} {testlink} { +} -result {1 {can't set "y": linked variable is read-only} 11} +test link-7.4 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar int y set y abc } - testlink delete testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $int -} {1 {can't set "y": variable must have integer value} -4} -test link-7.5 {access to linked variables via upvar} {testlink} { +} -result {1 {can't set "y": variable must have integer value} -4} +test link-7.5 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar real y set y abc } - testlink delete testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $real -} {1 {can't set "y": variable must have real value} 16.75} -test link-7.6 {access to linked variables via upvar} {testlink} { +} -result {1 {can't set "y": variable must have real value} 16.75} +test link-7.6 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar bool y set y abc } - testlink delete testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $bool -} {1 {can't set "y": variable must have boolean value} 1} -test link-7.7 {access to linked variables via upvar} {testlink} { +} -result {1 {can't set "y": variable must have boolean value} 1} +test link-7.7 {access to linked variables via upvar} -setup { + testlink delete +} -constraints {testlink} -body { proc x {} { upvar wide y set y abc } - testlink delete testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {} list [catch x msg] $msg $wide -} {1 {can't set "y": variable must have integer value} 778899} +} -result {1 {can't set "y": variable must have integer value} 778899} test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { @@ -245,7 +268,7 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} { trace var int w x testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 trace vdelete int w x - set x + return $x } {{int {} w} 32 -2.0 0 xyzzy 995511} test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { @@ -259,7 +282,7 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} { trace var int w x testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 trace vdelete int w x - set x + return $x } {} test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} { testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0 @@ -267,13 +290,18 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} { testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {} } msg] $msg $int } {0 {} 47} - + catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0} catch {testlink delete} foreach i {int real bool string wide} { - catch {unset $i} + unset -nocomplain $i } # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |