diff options
Diffstat (limited to 'contrib/tcl/tests/link.test')
| -rw-r--r-- | contrib/tcl/tests/link.test | 234 |
1 files changed, 0 insertions, 234 deletions
diff --git a/contrib/tcl/tests/link.test b/contrib/tcl/tests/link.test deleted file mode 100644 index 25eefb1bb315..000000000000 --- a/contrib/tcl/tests/link.test +++ /dev/null @@ -1,234 +0,0 @@ -# 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. -# -# Copyright (c) 1993 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# SCCS: @(#) link.test 1.12 97/01/21 21:16:04 - -if {[info commands testlink] == {}} { - puts "This application hasn't been compiled with the \"testlink\"" - puts "command, so I can't test Tcl_LinkVar et al." - return -} - -if {[string compare test [info procs test]] == 1} then {source defs} - -foreach i {int real bool string} { - catch {unset $i} -} -test link-1.1 {reading C variables from Tcl} { - testlink delete - testlink set 43 1.23 4 - - testlink create 1 1 1 1 - list $int $real $bool $string -} {43 1.23 1 NULL} -test link-1.2 {reading C variables from Tcl} { - testlink delete - testlink create 1 1 1 1 - testlink set -3 2 0 "A long string with spaces" - list $int $real $bool $string $int $real $bool $string -} {-3 2.0 0 {A long string with spaces} -3 2.0 0 {A long string with spaces}} - -test link-2.1 {writing C variables from Tcl} { - testlink delete - testlink set 43 1.21 4 - - testlink create 1 1 1 1 - set int "00721" - set real -10.5 - set bool true - set string abcdef - concat [testlink get] $int $real $bool $string -} {465 -10.5 1 abcdef 00721 -10.5 true abcdef} -test link-2.2 {writing bad values into variables} { - testlink delete - testlink set 43 1.23 4 - - testlink create 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 delete - testlink set 43 1.23 4 - - testlink create 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 delete - testlink set 43 1.23 4 - - testlink create 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-3.1 {read-only variables} { - testlink delete - testlink set 43 1.23 4 - - testlink create 0 1 1 0 - list [catch {set int 4} msg] $msg $int \ - [catch {set real 10.6} msg] $msg $real \ - [catch {set bool no} msg] $msg $bool \ - [catch {set string "new value"} msg] $msg $string -} {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} -test link-3.2 {read-only variables} { - testlink delete - testlink set 43 1.23 4 - - testlink create 1 0 0 1 - list [catch {set int 4} msg] $msg $int \ - [catch {set real 10.6} msg] $msg $real \ - [catch {set bool no} msg] $msg $bool \ - [catch {set string "new value"} msg] $msg $string -} {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}} - -test link-4.1 {unsetting linked variables} { - testlink delete - testlink set -6 -2.5 0 stringValue - testlink create 1 1 1 1 - unset int real bool string - list [catch {set int} msg] $msg [catch {set real} msg] $msg \ - [catch {set bool} msg] $msg [catch {set string} msg] $msg -} {0 -6 0 -2.5 0 0 0 stringValue} -test link-4.2 {unsetting linked variables} { - testlink delete - testlink set -6 -2.1 0 stringValue - testlink create 1 1 1 1 - unset int real bool string - set int 102 - set real 16 - set bool true - set string newValue - testlink get -} {102 16.0 1 newValue} - -test link-5.1 {unlinking variables} { - testlink delete - testlink set -6 -2.25 0 stringValue - testlink delete - set int xx1 - set real qrst - set bool bogus - set string 12345 - testlink get -} {-6 -2.25 0 stringValue} -test link-5.2 {unlinking variables} { - testlink delete - testlink set -6 -2.25 0 stringValue - testlink create 1 1 1 1 - testlink delete - testlink set 25 14.7 7 - - list $int $real $bool $string -} {-6 -2.25 0 stringValue} - -test link-6.1 {errors in setting up link} { - testlink delete - catch {unset int} - set int(44) 1 - list [catch {testlink create 1 1 1 1} msg] $msg -} {1 {can't set "int": variable is array}} -catch {unset int} - -test link-7.1 {access to linked variables via upvar} { - proc x {} { - upvar int y - unset y - } - testlink delete - testlink create 1 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} { - proc x {} { - upvar int y - return [set y] - } - testlink delete - testlink create 1 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} { - proc x {} { - upvar int y - set y 44 - } - testlink delete - testlink create 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} { - proc x {} { - upvar int y - set y abc - } - testlink delete - testlink create 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} { - proc x {} { - upvar real y - set y abc - } - testlink delete - testlink create 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} { - proc x {} { - upvar bool y - set y abc - } - testlink delete - testlink create 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-8.1 {Tcl_UpdateLinkedVar procedure} { - proc x args { - global x int real bool string - lappend x $args $int $real $bool $string - } - set x {} - testlink create 1 1 1 1 - testlink set 14 -2.0 0 xyzzy - trace var int w x - testlink update 32 4.0 3 abcd - trace vdelete int w x - set x -} {{int {} w} 32 -2.0 0 xyzzy} -test link-8.2 {Tcl_UpdateLinkedVar procedure} { - proc x args { - global x int real bool string - lappend x $args $int $real $bool $string - } - set x {} - testlink create 1 1 1 1 - testlink set 14 -2.0 0 xyzzy - testlink delete - trace var int w x - testlink update 32 4.0 6 abcd - trace vdelete int w x - set x -} {} -test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} { - testlink create 0 0 0 0 - list [catch {testlink update 47 {} {} {}} msg] $msg $int -} {0 {} 47} - -testlink delete -foreach i {int real bool string} { - catch {unset $i} -} |