Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | * tests/expr.test: * tests/for-old.test: * tests/for.test: * tests/foreach.test: * tests/format.test: * tests/httpold.test: * tests/if.test: * tests/init.test: * tests/interp.test: * tests/while.test: Added some tests for known bugs (marked with knownBug constraint), and cleaned up a few bad tests. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
Files: | files | file ages | folders |
SHA1: |
92c423cb2e3b2fdc52edd70710f2366b |
User & Date: | stanton 1999-04-02 23:44:37.000 |
Context
1999-04-02
| ||
23:44 | * generic/regc_locale.c: * generic/regcustom.h: * generic/tcl.decls: * generic/tclCmdIL.c: * generic... check-in: de06484e63 user: stanton tags: core-8-1-branch-old | |
23:44 | * tests/expr.test: * tests/for-old.test: * tests/for.test: * tests/foreach.test: * tests/format.test... check-in: 92c423cb2e user: stanton tags: core-8-1-branch-old | |
22:30 | safe-6.3 now passes on Windows and Unix for both release and debug. This addresses item 81 on the wh... check-in: 8c40033f93 user: hershey tags: core-8-1-branch-old | |
Changes
Changes to tests/expr.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-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. # # RCS: @(#) $Id: expr.test,v 1.1.2.6 1999/04/02 23:44:37 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { set gotT1 0 |
︙ | ︙ | |||
663 664 665 666 667 668 669 | set x [expr $x+$f+$center] set x [expr $x+$f+$center] set y [expr round($x)] } p } 3 | > | > > > > > | > > > > > > > > > > > | > > | | | | | | | | | | | | > > > > > | 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 | set x [expr $x+$f+$center] set x [expr $x+$f+$center] set y [expr round($x)] } p } 3 # Test for incorrect "double evaluation" semantics test expr-20.1 {wrong brace matching} { catch {unset l} catch {unset r} catch {unset q} catch {unset cmd} catch {unset a} set l "\{"; set r "\}"; set q "\"" set cmd "expr $l$q|$q == $q$r$q$r" list [catch $cmd a] $a } {1 {extra characters after close-brace}} test expr-20.2 {double invocation of variable traces} {knownBug} { set exprtracecounter 0 proc exprtraceproc {args} { upvar #0 exprtracecounter counter set argc [llength $args] set extraargs [lrange $args 0 [expr {$argc - 4}]] set name [lindex $args [expr {$argc - 3}]] upvar 1 $name var if {[incr counter] % 2 == 1} { set var "$counter oops [concat $extraargs]" } else { set var "$counter + [concat $extraargs]" } } trace variable exprtracevar r [list exprtraceproc 10] list [catch {expr "$exprtracevar + 20"} a] $a \ [catch {expr "$exprtracevar + 20"} b] $b \ [unset exprtracevar exprtracecounter] } {1 {syntax error in expression "1 oops 10 + 20"} 0 32 {}} test expr-20.3 {broken substitution of integer digits} { # fails with 8.0.x, but not 8.1b2 list [set a 000; expr 0x1$a] [set a 1; expr ${a}000] } {4096 1000} # cleanup unset a ::tcltest::cleanupTests return |
Changes to tests/for-old.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > | > | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: for-old.test,v 1.1.2.6 1999/04/02 23:44:38 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Check "for" and its use of continue and break. catch {unset a i} test for-old-1.1 {for tests} { set a {} for {set i 1} {$i<6} {set i [expr $i+1]} { |
︙ | ︙ |
Changes to tests/for.test.
1 2 3 4 5 6 7 8 9 10 11 | # Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: for.test,v 1.1.2.6 1999/04/02 23:44:38 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Basic "for" operation. test for-1.1 {TclCompileForCmd: missing initial command} { list [catch {for} msg] $msg } {1 {wrong # args: should be "for start test next command"}} test for-1.2 {TclCompileForCmd: error in initial command} { |
︙ | ︙ | |||
708 709 710 711 712 713 714 715 716 717 718 719 720 721 | set a } {} test for-5.15 {for cmd with computed command names: for command result} { set z for set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} # cleanup ::tcltest::cleanupTests return | > > > > > > > > > > > > > > > > > > > > | 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 | set a } {} test for-5.15 {for cmd with computed command names: for command result} { set z for set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} # Test for incorrect "double evaluation" semantics test for-6.1 {possible delayed substitution of increment command} {knownBug} { # Increment should be 5, and lappend should always append 5 catch {unset a} catch {unset i} set a 5 set i {} for {set a 1} {$a < 12} "incr a $a" {lappend i $a} set i } {1 6 11} test for-6.2 {possible delayed substitution of body command} {knownBug} { # Increment should be 5, and lappend should always append 5 set a 5 set i {} for {set a 1} {$a < 12} {incr a $a} "lappend i $a" set i } {5 5 5 5} # cleanup ::tcltest::cleanupTests return |
︙ | ︙ |
Changes to tests/foreach.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: foreach.test,v 1.1.2.6 1999/04/02 23:44:38 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset a} catch {unset x} # Basic "foreach" operation. test foreach-1.1 {basic foreach tests} { |
︙ | ︙ | |||
203 204 205 206 207 208 209 210 211 212 213 214 215 216 | set a } {a b} test foreach-5.3 {break tests} {catch {break foo} msg} 1 test foreach-5.4 {break tests} { catch {break foo} msg set msg } {wrong # args: should be "break"} # cleanup catch {unset a} catch {unset x} ::tcltest::cleanupTests return | > > > > > > > > > > > > > | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | set a } {a b} test foreach-5.3 {break tests} {catch {break foo} msg} 1 test foreach-5.4 {break tests} { catch {break foo} msg set msg } {wrong # args: should be "break"} # Test for incorrect "double evaluation" semantics test foreach-6.1 {delayed substitution of body} {knownBug} { proc foo {} { set a 0 foreach a [list 1 2 3] " set x $a " set x } foo } {0} # cleanup catch {unset a} catch {unset x} ::tcltest::cleanupTests return |
︙ | ︙ |
Changes to tests/format.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: format.test,v 1.1.2.7 1999/04/02 23:44:38 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # The following code is needed because some versions of SCO Unix have # a round-off error in sprintf which would cause some of the tests to # fail. Someday I hope this code shouldn't be necessary (code added # 9/9/91). |
︙ | ︙ |
Changes to tests/httpold.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: http_config, http_get, http_wait, http_reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: http_config, http_get, http_wait, http_reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 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. # # RCS: @(#) $Id: httpold.test,v 1.1.2.7 1999/04/02 23:44:38 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {package require http 1.0}]} { if {[info exist httpold]} { |
︙ | ︙ | |||
385 386 387 388 389 390 391 392 | test http-4.11 {httpEvent} { set token [http_get $url -timeout 1 -command {#}] http_reset $token http_status $token } {reset} test http-4.12 {httpEvent} { update set token [http_get $url -timeout 1 -command {#}] | > | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 | test http-4.11 {httpEvent} { set token [http_get $url -timeout 1 -command {#}] http_reset $token http_status $token } {reset} test http-4.12 {httpEvent} { update after 1000 {set x 1} set token [http_get $url -timeout 1 -command {#}] vwait x http_status $token } {timeout} test http-5.1 {http_formatQuery} { http_formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value+two} |
︙ | ︙ |
Changes to tests/if.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 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. # # RCS: @(#) $Id: if.test,v 1.1.2.7 1999/04/02 23:44:38 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Basic "if" operation. |
︙ | ︙ | |||
499 500 501 502 503 504 505 506 507 508 509 510 511 512 | # Check "if" and computed command names. catch {unset a} test if-5.1 {if cmd with computed command names: missing if/elseif test} { set z if list [catch {$z} msg] $msg } {1 {wrong # args: no expression after "if" argument}} test if-5.2 {if cmd with computed command names: error in if/elseif test} { set z if list [catch {$z {[error "error in condition"]} foo} msg] $msg } {1 {error in condition}} test if-5.3 {if cmd with computed command names: error in if/elseif test} { set z if list [catch {$z {1+}} msg] $msg $errorInfo | > | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | # Check "if" and computed command names. catch {unset a} test if-5.1 {if cmd with computed command names: missing if/elseif test} { set z if list [catch {$z} msg] $msg } {1 {wrong # args: no expression after "if" argument}} test if-5.2 {if cmd with computed command names: error in if/elseif test} { set z if list [catch {$z {[error "error in condition"]} foo} msg] $msg } {1 {error in condition}} test if-5.3 {if cmd with computed command names: error in if/elseif test} { set z if list [catch {$z {1+}} msg] $msg $errorInfo |
︙ | ︙ | |||
1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 | $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} } def test if-9.1 {if cmd with namespace qualifiers} { ::if {1} {set x 4} } 4 # cleanup ::tcltest::cleanupTests return | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 | $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi} } def test if-9.1 {if cmd with namespace qualifiers} { ::if {1} {set x 4} } 4 # Test for incorrect "double evaluation semantics" test if-10.1 {delayed substitution of then body} {knownBug} { set j 0 if {[incr j] == 1} " set result $j " set result } {0} test if-10.2 {delayed substitution of elseif expression} {knownBug} { set j 0 if {[incr j] == 0} { set result badthen } elseif "$j == 1" { set result badelseif } else { set result ok } set result } {ok} test if-10.3 {delayed substitution of elseif body} {knownBug} { set j 0 if {[incr j] == 0} { set result badthen } elseif {1} " set result $j " set result } {0} test if-10.4 {delayed substitution of else body} {knownBug} { set j 0 if {[incr j] == 0} { set result badthen } else " set result $j " set result } {0} test if-10.5 {substituted control words} {knownBug} { set then then; proc then {} {return badthen} set else else; proc else {} {return badelse} set elseif elseif; proc elseif {} {return badelseif} list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a } {0 ok} test if-10.6 {double invocation of variable traces} {knownBug} { set iftracecounter 0 proc iftraceproc {args} { upvar #0 iftracecounter counter set argc [llength $args] set extraargs [lrange $args 0 [expr {$argc - 4}]] set name [lindex $args [expr {$argc - 3}]] upvar 1 $name var if {[incr counter] % 2 == 1} { set var "$counter oops [concat $extraargs]" } else { set var "$counter + [concat $extraargs]" } } trace variable iftracevar r [list iftraceproc 10] list [catch {if "$iftracevar + 20" {}} a] $a \ [catch {if "$iftracevar + 20" {}} b] $b \ [unset iftracevar iftracecounter] } {1 {syntax error in expression "1 oops 10 + 20"} 0 {} {}} # cleanup ::tcltest::cleanupTests return |
︙ | ︙ |
Changes to tests/init.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 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. # # RCS: @(#) $Id: init.test,v 1.1.2.6 1999/04/02 23:44:39 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Clear out any namespaces called test_ns_* catch {eval namespace delete [namespace children :: test_ns_*]} |
︙ | ︙ | |||
61 62 63 64 65 66 67 | set testInterp [interp create] interp eval $testInterp [list set argv $argv] interp eval $testInterp [list source [file join $::tcltest::testsDir defs.tcl]] interp eval $testInterp { | > | > | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | set testInterp [interp create] interp eval $testInterp [list set argv $argv] interp eval $testInterp [list source [file join $::tcltest::testsDir defs.tcl]] interp eval $testInterp { if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } auto_reset catch {rename parray {}} test init-2.0 {load parray - stage 1} { set ret [catch {namespace eval ::tcltest {parray}} error] rename parray {} ; # remove it, for the next test - that should not fail. |
︙ | ︙ |
Changes to tests/interp.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 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. # # RCS: @(#) $Id: interp.test,v 1.1.2.10 1999/04/02 23:44:39 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # The set of hidden commands is platform dependent: |
︙ | ︙ | |||
2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 | myNewSet a $value return $a } catch {unset a} set result [testMyNewSet "ok"] rename testMyNewSet {} rename mySet {} set result } ok # cleanup foreach i [interp slaves] { interp delete $i } ::tcltest::cleanupTests return | > | 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 | myNewSet a $value return $a } catch {unset a} set result [testMyNewSet "ok"] rename testMyNewSet {} rename mySet {} rename myNewSet {} set result } ok # cleanup foreach i [interp slaves] { interp delete $i } ::tcltest::cleanupTests return |
Changes to tests/while.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: while # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 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. # | | | > | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # Commands covered: while # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 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. # # RCS: @(#) $Id: while.test,v 1.1.2.6 1999/04/02 23:44:39 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Basic "while" operation. catch {unset i} catch {unset a} test while-1.1 {TclCompileWhileCmd: missing test expression} { catch {while } msg set msg } {wrong # args: should be "while test command"} test while-1.2 {TclCompileWhileCmd: error in test expression} { set i 0 catch {while {$i<} break} msg set errorInfo } {syntax error in expression "$i<" ("while" test expression) while compiling "while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg } {1 {can't use non-numeric string as operand of "+"}} test while-1.4 {TclCompileWhileCmd: multiline test expr} { set value 1 while {($tcl_platform(platform) != "foobar1") && \ |
︙ | ︙ | |||
600 601 602 603 604 605 606 607 608 609 610 611 612 613 | catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 3} # cleanup ::tcltest::cleanupTests return | > > > > > > > > > > | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 | catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 3} # Test for incorrect "double evaluation" semantics test while-7.1 {delayed substitution of body} {knownBug} { set i 0 while {[incr i] < 10} " set result $i " set result } {0} # cleanup ::tcltest::cleanupTests return |
︙ | ︙ |