Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | For Parse/eval, select modernizations from Patrick Fradin. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-8-5-branch |
Files: | files | file ages | folders |
SHA1: |
529efda54975ccd5f315b96bed742b98 |
User & Date: | dgp 2013-01-30 20:42:10 |
Context
2013-01-30
| ||
20:49 | For msgcat, select modernizations from Patrick Fradin + -debug fix. check-in: 927b8c4de9 user: dgp tags: core-8-5-branch | |
20:42 | For Parse/eval, select modernizations from Patrick Fradin. check-in: 529efda549 user: dgp tags: core-8-5-branch | |
19:18 | (::platform::LibcVersion): See [Bug 3599098]: Fixed the RE extracting the version to avoid issues w... check-in: e70b932ea4 user: andreask tags: core-8-5-branch | |
Changes
Changes to tests/assocd.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file tests the AssocData 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) 1991-1994 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. | < | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # This file tests the AssocData 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) 1991-1994 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. package require tcltest 2 namespace import ::tcltest::* testConstraint testgetassocdata [llength [info commands testgetassocdata]] testConstraint testsetassocdata [llength [info commands testsetassocdata]] testConstraint testdelassocdata [llength [info commands testdelassocdata]] test assocd-1.1 {testing setting assoc data} testsetassocdata { testsetassocdata a 1 |
︙ | ︙ | |||
53 54 55 56 57 58 59 | testdelassocdata 123 } "" test assocd-3.3 {testing deleting assoc data} testdelassocdata { list [catch {testdelassocdata nonexistent} msg] $msg } {0 {}} # cleanup | | | 51 52 53 54 55 56 57 58 59 | testdelassocdata 123 } "" test assocd-3.3 {testing deleting assoc data} testdelassocdata { list [catch {testdelassocdata nonexistent} msg] $msg } {0 {}} # cleanup cleanupTests return |
Changes to tests/basic.test.
︙ | ︙ | |||
12 13 14 15 16 17 18 | # 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. package require tcltest 2 | | | | 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 | # 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. package require tcltest 2 namespace import ::tcltest::* testConstraint testevalex [llength [info commands testevalex]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] testConstraint testcreatecommand [llength [info commands testcreatecommand]] testConstraint exec [llength [info commands exec]] catch {namespace delete test_ns_basic} catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} unset -nocomplain x test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_basic { proc p {} { |
︙ | ︙ | |||
295 296 297 298 299 300 301 | test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} { } {} test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} | | | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 | test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} { } {} test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} unset -nocomplain x set x [namespace eval test_ns_basic::test_ns_basic2 { # the following creates a cmd in the global namespace testcmdtoken create p }] list [testcmdtoken name $x] \ [rename ::p q] \ [testcmdtoken name $x] |
︙ | ︙ | |||
348 349 350 351 352 353 354 | } {::foreach ::test_ns_basic3::q ::test_ns_basic3::p ::test_ns_basic3::cmd1 ::test_ns_basic2::cmd2} test basic-23.1 {Tcl_DeleteCommand} {emptyTest} { } {} test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} { catch {interp delete test_interp} | | | 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 | } {::foreach ::test_ns_basic3::q ::test_ns_basic3::p ::test_ns_basic3::cmd1 ::test_ns_basic2::cmd2} test basic-23.1 {Tcl_DeleteCommand} {emptyTest} { } {} test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} { catch {interp delete test_interp} unset -nocomplain x interp create test_interp interp eval test_interp { proc useSet {} { return [set a 123] } } set x [interp eval test_interp {useSet}] |
︙ | ︙ | |||
420 421 422 423 424 425 426 | set fName [makeFile {} test1] } -body { # If object isn't preserved, errorInfo would be set to # "foo\n while executing\n\"garbage bytes\"" because the object's # string would have been freed, leaving garbage bytes for the error # message. set f [open $fName w] | | | 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 | set fName [makeFile {} test1] } -body { # If object isn't preserved, errorInfo would be set to # "foo\n while executing\n\"garbage bytes\"" because the object's # string would have been freed, leaving garbage bytes for the error # message. set f [open $fName w] chan event $f writable "chan event $f writable {}; error foo" set x {} vwait x close $f set x } -cleanup { removeFile test1 interp bgerror {} $handler |
︙ | ︙ | |||
540 541 542 543 544 545 546 | test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} { } {} test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} { catch {close $f} set res [catch { set f [open |[list [interpreter]] w+] | | | | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 | test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} { } {} test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} { catch {close $f} set res [catch { set f [open |[list [interpreter]] w+] chan configure $f -buffering line puts $f {chan configure stdout -buffering line} puts $f continue puts $f {puts $::errorInfo} puts $f {puts DONE} set newMsg {} set msg {} while {$newMsg != "DONE"} { set newMsg [gets $f] |
︙ | ︙ | |||
963 964 965 966 967 968 969 | catch {namespace delete {*}[namespace children :: test_ns_*]} catch {namespace delete george} catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} | | | | 963 964 965 966 967 968 969 970 971 972 | catch {namespace delete {*}[namespace children :: test_ns_*]} catch {namespace delete george} catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} unset -nocomplain x cleanupTests return |
Changes to tests/cmdInfo.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # Copyright (c) 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. | < | | < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # Copyright (c) 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. package require tcltest 2 namespace import ::tcltest::* testConstraint testcmdinfo [llength [info commands testcmdinfo]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo get x1 |
︙ | ︙ | |||
94 95 96 97 98 99 100 | rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 lappend y {*}[testcmdtoken name $x] } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} | | | 92 93 94 95 96 97 98 99 100 101 102 103 104 | rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 lappend y {*}[testcmdtoken name $x] } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/dcall.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # 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. | < | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # 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. package require tcltest 2 namespace import ::tcltest::* testConstraint testdcall [llength [info commands testdcall]] test dcall-1.1 {deletion callbacks} testdcall { lsort -increasing [testdcall 1 2 3] } {1 2 3} test dcall-1.2 {deletion callbacks} testdcall { |
︙ | ︙ | |||
34 35 36 37 38 39 40 | lsort -increasing [testdcall 20 21 22 -21] } {20 22} test dcall-1.6 {deletion callbacks} testdcall { lsort -increasing [testdcall 20 21 22 -21 -22 -20] } {} # cleanup | | | 32 33 34 35 36 37 38 39 40 | lsort -increasing [testdcall 20 21 22 -21] } {20 22} test dcall-1.6 {deletion callbacks} testdcall { lsort -increasing [testdcall 20 21 22 -21 -22 -20] } {} # cleanup cleanupTests return |
Changes to tests/expr-old.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | < | | < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.1 namespace import ::tcltest::* testConstraint testexprlong [llength [info commands testexprlong]] testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { |
︙ | ︙ | |||
138 139 140 141 142 143 144 | test expr-old-1.47 {integer operators} {expr 36%-5} -4 test expr-old-1.48 {integer operators} {expr -36/-5} 7 test expr-old-1.49 {integer operators} {expr -36%-5} -1 test expr-old-1.50 {integer operators} {expr +36} 36 test expr-old-1.51 {integer operators} {expr +--++36} 36 test expr-old-1.52 {integer operators} {expr +36%+5} 1 test expr-old-1.53 {integer operators} { | | | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | test expr-old-1.47 {integer operators} {expr 36%-5} -4 test expr-old-1.48 {integer operators} {expr -36/-5} 7 test expr-old-1.49 {integer operators} {expr -36%-5} -1 test expr-old-1.50 {integer operators} {expr +36} 36 test expr-old-1.51 {integer operators} {expr +--++36} 36 test expr-old-1.52 {integer operators} {expr +36%+5} 1 test expr-old-1.53 {integer operators} { unset -nocomplain x set x yes list [expr {1 && $x}] [expr {$x && 1}] \ [expr {0 || $x}] [expr {$x || 0}] } {1 1 1 1} # Check the floating-point operators individually, along with # automatic conversion to integers where needed. |
︙ | ︙ | |||
446 447 448 449 450 451 452 | test expr-old-23.3 {double quotes} { set b2 xyx expr {"$b2$b2$b2.[set b2].[set b2]"} } xyxxyxxyx.xyx.xyx test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22 test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc} test expr-old-23.6 {double quotes} { | | | 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | test expr-old-23.3 {double quotes} { set b2 xyx expr {"$b2$b2$b2.[set b2].[set b2]"} } xyxxyxxyx.xyx.xyx test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22 test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc} test expr-old-23.6 {double quotes} { unset -nocomplain bogus__ list [catch {expr {"$bogus__"}} msg] $msg } {1 {can't read "bogus__": no such variable}} test expr-old-23.7 {double quotes} { list [catch {expr {"a[error Testing]bc"}} msg] $msg } {1 Testing} test expr-old-23.8 {double quotes} { list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg |
︙ | ︙ | |||
495 496 497 498 499 500 501 | } {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * test expr-old-26.3 {error conditions} -body { expr 2+4*( } -returnCodes error -match glob -result * | | | 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 | } {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * test expr-old-26.3 {error conditions} -body { expr 2+4*( } -returnCodes error -match glob -result * unset -nocomplain _non_existent_ test expr-old-26.4 {error conditions} { list [catch {expr 2+$_non_existent_} msg] $msg } {1 {can't read "_non_existent_": no such variable}} set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} |
︙ | ︙ | |||
574 575 576 577 578 579 580 | set a } 1 test expr-old-27.4 {cancelled evaluation} { set a 1 expr {1?2:[set a 2]} set a } 1 | | | 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 | set a } 1 test expr-old-27.4 {cancelled evaluation} { set a 1 expr {1?2:[set a 2]} set a } 1 unset -nocomplain x test expr-old-27.5 {cancelled evaluation} { list [catch {expr {[info exists x] && $x}} msg] $msg } {0 0} test expr-old-27.6 {cancelled evaluation} { list [catch {expr {0 && [concat $x]}} msg] $msg } {0 0} test expr-old-27.7 {cancelled evaluation} { |
︙ | ︙ |
Changes to tests/parse.test.
︙ | ︙ | |||
431 432 433 434 435 436 437 | interp delete $::slave catch {rename ::noSuchCommand {}} set ::info } global test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { | | | 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 | interp delete $::slave catch {rename ::noSuchCommand {}} set ::info } global test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { unset -nocomplain x list [catch {testevalex {for {} 1 {} { # asdf set x }}}] $::errorInfo } {1 {can't read "x": no such variable |
︙ | ︙ | |||
472 473 474 475 476 477 478 | test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { testevalex {concat test\063\062test} } {test32test} test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr 2 + 6]} } {8} test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { | | | | | | | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 | test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { testevalex {concat test\063\062test} } {test32test} test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr 2 + 6]} } {8} test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { unset -nocomplain a list [catch {testevalex {concat xxx[expr $a]}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { set a hello testevalex {concat $a} } {hello} test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a set a(12) 46 testevalex {concat $a(12)} } {46} test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a set a(12) 46 testevalex {concat $a(1[expr 3 - 1])} } {46} test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a list [catch {testevalex {concat $x($a)}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.9 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a list [catch {testevalex {concat xyz$a(1)}} msg] $msg } {1 {can't read "a(1)": no such variable}} test parse-10.10 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a} } {123} test parse-10.11 {Tcl_EvalTokens, object values} testevalex { |
︙ | ︙ | |||
534 535 536 537 538 539 540 | } -body { x } -result {321 777} test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex { list [catch {testevalex {concat "abc}} msg] $msg } {1 {missing "}} test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex { | | | | | 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | } -body { x } -result {321 777} test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex { list [catch {testevalex {concat "abc}} msg] $msg } {1 {missing "}} test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex { unset -nocomplain a list [catch {testevalex {concat xyz $a}} msg] $msg } {1 {can't read "a": no such variable}} test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex { unset -nocomplain a list [catch {testevalex {_bogus_ a b c d}} msg] $msg } {1 {invalid command name "_bogus_"}} test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex { list [catch {testevalex {break}} msg] $msg } {3 {}} test parse-11.6 {Tcl_EvalEx, freeing memory} testevalex { testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z} } {a b c d e f g h i j k l m n o p q r s t u v w x y z} test parse-11.7 {Tcl_EvalEx, multiple commands in script} testevalex { list [testevalex {set a b; set c d}] $a $c } {d b d} test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex { list [testevalex { set a b set c d }] $a $c } {d b d} test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex { unset -nocomplain a list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg } {1 {can't read "a": no such variable}} test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex { testevalex {concat xyz; } } {xyz} test parse-11.11 {Tcl_EvalTokens, empty commands} testevalex { testevalex "concat abc; ; # this is a comment\n" |
︙ | ︙ | |||
663 664 665 666 667 668 669 | test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$} } {{$} {}} test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$.123} } {{$} .123} test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar { | | | | 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 | test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$} } {{$} {}} test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$.123} } {{$} .123} test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar { unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { unset -nocomplain abc list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg } {1 {invalid command name "bogus"}} test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { |
︙ | ︙ |
Changes to tests/parseExpr.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for the procedures in the # file tclCompExpr.c. 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 | # This file contains a collection of tests for the procedures in the # file tclCompExpr.c. 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. package require tcltest 2 namespace import ::tcltest::* # Note that the Tcl expression parser (tclCompExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands # of "<<" are integers. testConstraint testexprparser [llength [info commands testexprparser]] |
︙ | ︙ | |||
1051 1052 1053 1054 1055 1056 1057 | } -returnCodes error -match glob -result {*invalid binary number*} test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body { testexprparser 0b02 -1 } -returnCodes error -match glob -result {*invalid binary number*} # cleanup | | | 1049 1050 1051 1052 1053 1054 1055 1056 1057 | } -returnCodes error -match glob -result {*invalid binary number*} test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body { testexprparser 0b02 -1 } -returnCodes error -match glob -result {*invalid binary number*} # cleanup cleanupTests return |
Changes to tests/parseOld.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. | < | | < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # 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. package require tcltest namespace import ::tcltest::* testConstraint testwordend [llength [info commands testwordend]] # Save the argv value for restoration later set savedArgv $argv proc fourArgs {a b c d} { |
︙ | ︙ | |||
159 160 161 162 163 164 165 | } a78b test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1 test parseOld-5.6 {variable substitution} { catch {$_non_existent_} msg set msg } {can't read "_non_existent_": no such variable} test parseOld-5.7 {array variable substitution} { | | | | | | | | | | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | } a78b test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1 test parseOld-5.6 {variable substitution} { catch {$_non_existent_} msg set msg } {can't read "_non_existent_": no such variable} test parseOld-5.7 {array variable substitution} { unset -nocomplain a set a(xyz) 123 set b $a(xyz)foo set b } 123foo test parseOld-5.8 {array variable substitution} { unset -nocomplain a set "a(x y z)" 123 set b $a(x y z)foo set b } 123foo test parseOld-5.9 {array variable substitution} { unset -nocomplain a qqq set "a(x y z)" qqq set $a([format x]\ y [format z]) foo set qqq } foo test parseOld-5.10 {array variable substitution} { unset -nocomplain a list [catch {set b $a(22)} msg] $msg } {1 {can't read "a(22)": no such variable}} test parseOld-5.11 {array variable substitution} { set b a$! set b } {a$!} test parseOld-5.12 {empty array name support} { list [catch {set b a$()} msg] $msg } {1 {can't read "()": no such variable}} unset -nocomplain a test parseOld-5.13 {array variable substitution} { unset -nocomplain a set long {This is a very long variable, long enough to cause storage \ allocation to occur in Tcl_ParseVar. If that storage isn't getting \ freed up correctly, then a core leak will occur when this test is \ run. This text is probably beginning to sound like drivel, but I've \ run out of things to say and I need more characters still.} set a($long) 777 set b $a($long) list $b [array names a] } {777 {{This is a very long variable, long enough to cause storage \ allocation to occur in Tcl_ParseVar. If that storage isn't getting \ freed up correctly, then a core leak will occur when this test is \ run. This text is probably beginning to sound like drivel, but I've \ run out of things to say and I need more characters still.}}} test parseOld-5.14 {array variable substitution} { unset -nocomplain a b a1 set a1(22) foo set a(foo) bar set b $a($a1(22)) set b } bar unset -nocomplain a a1 test parseOld-7.1 {backslash substitution} { set a "\a\c\n\]\}" string length $a } 5 test parseOld-7.2 {backslash substitution} { set a {\a\c\n\]\}} |
︙ | ︙ |
Changes to tests/result.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the routines in tclResult.c. # # 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) 1997 by 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 | # This file tests the routines in tclResult.c. # # 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) 1997 by 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. package require tcltest 2 namespace import ::tcltest::* # Some tests require the testsaveresult command testConstraint testsaveresult [llength [info commands testsaveresult]] testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]] testConstraint testseterrorcode [llength [info commands testseterrorcode]] testConstraint testreturn [llength [info commands testreturn]] |
︙ | ︙ |
Changes to tests/stack.test.
1 2 3 4 5 6 7 8 9 10 11 | # Tests that the stack size is big enough for the application. # # 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) 1998-2000 Ajuba Solutions. # # 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 | # Tests that the stack size is big enough for the application. # # 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) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2 namespace import ::tcltest::* # Note that a failure in this test results in a crash of the executable. # In order to avoid that, we do a basic check of the current stacksize. # This size can be changed with ulimit (ksh/bash/sh) or limit (csh/tcsh). # This doesn't catch all cases, for example threads of lower stacksize # can still squeak through. A core check is really needed. -- JH |
︙ | ︙ |