diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/cmdAH.test | 20 | ||||
| -rw-r--r-- | tests/for.test | 129 | ||||
| -rw-r--r-- | tests/regexp.test | 7 | ||||
| -rw-r--r-- | tests/string.test | 164 |
4 files changed, 214 insertions, 106 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 19ef9c4..0ae7156 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.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. # -# RCS: @(#) $Id: cmdAH.test,v 1.5 1999/04/16 00:47:24 stanton Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.6 1999/05/22 01:20:14 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1431,28 +1431,28 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} { # Error conditions -test cmdAH-30.1 {error conditions} { +test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} { list [catch {file gorp x} msg] $msg } {1 {bad option "gorp": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.2 {error conditions} { +test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} { list [catch {file ex x} msg] $msg } {1 {ambiguous option "ex": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.3 {error conditions} { +test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} { list [catch {file is x} msg] $msg } {1 {ambiguous option "is": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.4 {error conditions} { +test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} { list [catch {file z x} msg] $msg } {1 {bad option "z": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.5 {error conditions} { +test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} { list [catch {file read x} msg] $msg } {1 {ambiguous option "read": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.6 {error conditions} { +test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} { list [catch {file s x} msg] $msg } {1 {ambiguous option "s": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.7 {error conditions} { +test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} { list [catch {file t x} msg] $msg } {1 {ambiguous option "t": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} -test cmdAH-30.8 {error conditions} { +test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} { list [catch {file dirname ~woohgy} msg] $msg } {1 {user "woohgy" doesn't exist}} @@ -1460,6 +1460,8 @@ test cmdAH-30.8 {error conditions} { catch {testsetplatform $platform} catch {unset platform} +# Tcl_ForObjCmd is tested in for.test + catch {exec chmod 777 dir.file} file delete -force dir.file file delete gorp.file diff --git a/tests/for.test b/tests/for.test index 4503c0b..e60f17a 100644 --- a/tests/for.test +++ b/tests/for.test @@ -9,7 +9,7 @@ # 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.3 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: for.test,v 1.4 1999/05/22 01:20:14 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -584,45 +584,77 @@ test for-4.1 {break must reset the interp result} { set j } {} -# Basic "for" operation with computed command names. -test for-5.1 {for cmd with computed command names: missing initial command} { - set z for - list [catch {$z} msg] $msg -} {1 {wrong # args: should be "for start test next command"}} -test for-5.2 {for cmd with computed command names: error in initial command} { +# Test for incorrect "double evaluation" semantics + +test for-5.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-5.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} + +# In the following tests we need to bypass the bytecode compiler by +# substituting the command from a variable. This ensures that command +# procedure is invoked directly. + +test for-6.1 {Tcl_ForObjCmd: number of args} { set z for - list [catch {$z {set}} msg] $msg $errorInfo -} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command" - while executing -"$z {set}"}} -test for-5.3 {for cmd with computed command names: missing test expression} { + catch {$z} msg + set msg +} {wrong # args: should be "for start test next command"} +test for-6.2 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0}} msg set msg } {wrong # args: should be "for start test next command"} -test for-5.4 {for cmd with computed command names: error in test expression} { - set z for - catch {$z {set i 0} {$i<}} msg - set errorInfo -} {wrong # args: should be "for start test next command" - while executing -"$z {set i 0} {$i<}"} -test for-5.5 {for cmd with computed command names: test expression is enclosed in quotes} { - set z for - set i 0 - $z {} "$i > 5" {incr i} {} -} {} -test for-5.6 {for cmd with computed command names: missing "next" command} { +test for-6.3 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0} {$i < 5}} msg set msg } {wrong # args: should be "for start test next command"} -test for-5.7 {for cmd with computed command names: missing command body} { +test for-6.4 {Tcl_ForObjCmd: number of args} { set z for catch {$z {set i 0} {$i < 5} {incr i}} msg set msg } {wrong # args: should be "for start test next command"} -test for-5.8 {for cmd with computed command names: error executing command body} { +test for-6.5 {Tcl_ForObjCmd: number of args} { + set z for + catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg + set msg +} {wrong # args: should be "for start test next command"} +test for-6.6 {Tcl_ForObjCmd: error in initial command} { + set z for + list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo +} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" + while compiling +"set" + ("for" initial command) + invoked from within +"$z {set} {$i < 5} {incr i} {body}"}} +test for-6.7 {Tcl_ForObjCmd: error in test expression} { + set z for + list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo +} {1 {syntax error in expression "i < 5"} {syntax error in expression "i < 5" + while executing +"$z {set i 0} {i < 5} {incr i} {body}"}} +test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} { + set z for + set i 0 + $z {set i 6} "$i > 5" {incr i} {set y $i} + set i +} 6 +test for-6.9 {Tcl_ForObjCmd: error executing command body} { set z for catch {$z {set i 0} {$i < 5} {incr i} {set}} msg set errorInfo @@ -632,7 +664,7 @@ test for-5.8 {for cmd with computed command names: error executing command body} ("for" body line 1) invoked from within "$z {set i 0} {$i < 5} {incr i} {set}"} -test for-5.9 {for cmd with computed command names: simple command body} { +test for-6.10 {Tcl_ForObjCmd: simple command body} { set z for set a {} $z {set i 1} {$i<6} {set i [expr $i+1]} { @@ -641,13 +673,13 @@ test for-5.9 {for cmd with computed command names: simple command body} { } set a } {1 2 3} -test for-5.10 {for cmd with computed command names: command body in quotes} { +test for-6.11 {Tcl_ForObjCmd: command body in quotes} { set z for set a {} $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x" set a } {xxxxx} -test for-5.11 {for cmd with computed command names: computed command body} { +test for-6.12 {Tcl_ForObjCmd: computed command body} { set z for catch {unset x1} catch {unset bb} @@ -659,7 +691,7 @@ test for-5.11 {for cmd with computed command names: computed command body} { $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2 set a } {x1} -test for-5.12 {for cmd with computed command names: error in "next" command} { +test for-6.13 {Tcl_ForObjCmd: error in "next" command} { set z for catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg set errorInfo @@ -669,7 +701,7 @@ test for-5.12 {for cmd with computed command names: error in "next" command} { ("for" loop-end command) invoked from within "$z {set i 0} {$i < 5} {set} {set j 4}"} -test for-5.13 {for cmd with computed command names: long command body} { +test for-6.14 {Tcl_ForObjCmd: long command body} { set z for set a {} $z {set i 1} {$i<6} {set i [expr $i+1]} { @@ -704,49 +736,20 @@ test for-5.13 {for cmd with computed command names: long command body} { } set a } {1 2 3} -test for-5.14 {for cmd with computed command names: for command result} { +test for-6.15 {Tcl_ForObjCmd: for command result} { set z for set a [$z {set i 0} {$i < 5} {incr i} {}] set a } {} -test for-5.15 {for cmd with computed command names: for command result} { +test for-6.16 {Tcl_ForObjCmd: 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 - - - - - - - - - - - diff --git a/tests/regexp.test b/tests/regexp.test index d1e58cd..c6c5b40 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: regexp.test,v 1.4 1999/05/13 01:50:33 stanton Exp $ +# RCS: @(#) $Id: regexp.test,v 1.5 1999/05/22 01:20:14 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -381,11 +381,14 @@ test regexp-13.2 {CompileRegexp: regexp cache, different flags} { append x *a regexp -nocase $x bbba } 1 +test regexp-13.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { + makeFile {puts [regexp {} foo]} junk.tcl + exec $tcltest junk.tcl +} 1 set x 1 set y 2 regexp "$x$y" 123 - # cleanup ::tcltest::cleanupTests diff --git a/tests/string.test b/tests/string.test index 71f83be..d517db5 100644 --- a/tests/string.test +++ b/tests/string.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.9 1999/05/06 22:50:04 stanton Exp $ +# RCS: @(#) $Id: string.test,v 1.10 1999/05/22 01:20:14 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -129,33 +129,48 @@ test string-3.8 {string equal with length, unequal strings} { string equal -length 2 abc abde } 1 -test string-4.1 {string first} { +test string-4.1 {string first, too few args} { list [catch {string first a} msg] $msg -} {1 {wrong # args: should be "string first string1 string2"}} -test string-4.2 {string first} { +} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}} +test string-4.2 {string first, bad args} { list [catch {string first a b c} msg] $msg -} {1 {wrong # args: should be "string first string1 string2"}} -test string-4.3 {string first} { +} {1 {bad index "c": must be integer or end?-integer?}} +test string-4.3 {string first, too many args} { + list [catch {string first a b 5 d} msg] $msg +} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}} +test string-4.4 {string first} { string first bq abcdefgbcefgbqrs } 12 -test string-4.4 {string first} { +test string-4.5 {string first} { string fir bcd abcdefgbcefgbqrs } 1 -test string-4.5 {string first} { +test string-4.6 {string first} { string f b abcdefgbcefgbqrs } 1 -test string-4.6 {string first} { +test string-4.7 {string first} { string first xxx x123xx345xxx789xxx012 } 9 -test string-4.7 {string first} { +test string-4.8 {string first} { string first "" x123xx345xxx789xxx012 } -1 -test string-4.8 {string first, unicode} { +test string-4.9 {string first, unicode} { string first x abc\u7266x } 4 -test string-4.9 {string first, unicode} { +test string-4.10 {string first, unicode} { string first \u7266 abc\u7266x } 3 +test string-4.11 {string first, start index} { + string first \u7266 abc\u7266x 3 +} 3 +test string-4.12 {string first, start index} { + string first \u7266 abc\u7266x 4 +} -1 +test string-4.13 {string first, start index} { + string first \u7266 abc\u7266x end-2 +} 3 +test string-4.14 {string first, start index} { + string first a abcabc end-4 +} 3 test string-5.1 {string index} { list [catch {string index} msg] $msg @@ -190,6 +205,9 @@ test string-5.10 {string index, unicode} { test string-5.11 {string index, unicode} { string index abc\u7266d 3 } \u7266 +test string-5.12 {string index, unicode over char length, under byte length} { + string index \334\374\334\374 6 +} {} test string-6.1 {string is, too few args} { list [catch {string is} msg] $msg @@ -205,10 +223,10 @@ test string-6.4 {string is, too many args} { } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.5 {string is, class check} { list [catch {string is bogus str} msg] $msg -} {1 {bad class "bogus": must be alnum, alpha, ascii, boolean, digit, double, false, integer, lower, space, true, upper, or wordchar}} +} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wordchar, or xdigit}} test string-6.6 {string is, ambiguous class} { list [catch {string is al str} msg] $msg -} {1 {ambiguous class "al": must be alnum, alpha, ascii, boolean, digit, double, false, integer, lower, space, true, upper, or wordchar}} +} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wordchar, or xdigit}} test string-6.7 {string is alpha, all ok} { string is alpha -strict -failindex var abc } 1 @@ -446,39 +464,91 @@ test string-6.82 {string is wordchar, false} { test string-6.83 {string is wordchar, unicode false} { list [string is wordchar -fail var abc\u0080def] $var } {0 3} +test string-6.84 {string is control} { + ## Control chars are in the ranges + ## 00..1F && 7F..9F + list [string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60] $var +} {0 7} +test string-6.85 {string is control} { + string is control \u0100 +} 0 +test string-6.86 {string is graph} { + ## graph is any print char, except space + list [string is gra -fail var "0123abc!@#\$\u0100 "] $var +} {0 12} +test string-6.87 {string is print} { + ## basically any printable char + list [string is print -fail var "0123abc!@#\$\u0100 \u0010"] $var +} {0 13} +test string-6.88 {string is punct} { + ## any graph char that isn't alnum + list [string is punct -fail var "_=!@#\$\u00beq0"] $var +} {0 7} +test string-6.89 {string is xdigit} { + list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var +} {0 22} -test string-7.1 {string last} { +test string-7.1 {string last, too few args} { list [catch {string last a} msg] $msg -} {1 {wrong # args: should be "string last string1 string2"}} -test string-7.2 {string last} { +} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}} +test string-7.2 {string last, bad args} { list [catch {string last a b c} msg] $msg -} {1 {wrong # args: should be "string last string1 string2"}} -test string-7.3 {string last} { +} {1 {bad index "c": must be integer or end?-integer?}} +test string-7.3 {string last, too many args} { + list [catch {string last a b c d} msg] $msg +} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}} +test string-7.4 {string last} { string la xxx xxxx123xx345x678 } 1 -test string-7.4 {string last} { +test string-7.5 {string last} { string last xx xxxx123xx345x678 } 7 -test string-7.5 {string last} { +test string-7.6 {string last} { string las x xxxx123xx345x678 } 12 -test string-7.6 {string last, unicode} { +test string-7.7 {string last, unicode} { string las x xxxx12\u7266xx345x678 } 12 -test string-7.7 {string last, unicode} { +test string-7.8 {string last, unicode} { + string las \u7266 xxxx12\u7266xx345x678 +} 6 +test string-7.9 {string last, stop index} { + string las \u7266 xxxx12\u7266xx345x678 +} 6 +test string-7.10 {string last, unicode} { string las \u7266 xxxx12\u7266xx345x678 } 6 +test string-7.11 {string last, start index} { + string last \u7266 abc\u7266x 3 +} 3 +test string-7.12 {string last, start index} { + string last \u7266 abc\u7266x 2 +} -1 +test string-7.13 {string last, start index} { + ## Constrain to last 'a' should work + string last ba badbad end-1 +} 3 +test string-7.14 {string last, start index} { + ## Constrain to last 'b' should skip last 'ba' + string last ba badbad end-2 +} 0 +test string-7.15 {string last, start index} { + string last \334a \334ad\334ad 0 +} -1 +test string-7.16 {string last, start index} { + string last \334a \334ad\334ad end-1 +} 3 -test cmdMZ-8.1 {Tcl_StringObjCmd: string bytelength} { +test string-8.1 {string bytelength} { list [catch {string bytelength} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} -test cmdMZ-8.2 {Tcl_StringObjCmd: string bytelength} { +test string-8.2 {string bytelength} { list [catch {string bytelength a b} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} -test cmdMZ-8.3 {Tcl_StringObjCmd: string bytelength} { +test string-8.3 {string bytelength} { string bytelength "\u00c7" } 2 -test cmdMZ-8.4 {Tcl_StringObjCmd: string bytelength} { +test string-8.4 {string bytelength} { string b "" } 0 @@ -538,12 +608,12 @@ test string-10.13 {string map, -nocase unicode} { string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU" } aue\334\334\0EU -test string-11.1 {string match} { +test string-11.1 {string match, too few args} { list [catch {string match a} msg] $msg -} {1 {wrong # args: should be "string match pattern string"}} -test string-11.2 {string match} { - list [catch {string match a b c} msg] $msg -} {1 {wrong # args: should be "string match pattern string"}} +} {1 {wrong # args: should be "string match ?-nocase? pattern string"}} +test string-11.2 {string match, too many args} { + list [catch {string match a b c d} msg] $msg +} {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test string-11.3 {string match} { string match abc abc } 1 @@ -625,6 +695,36 @@ test string-11.28 {string match} { test string-11.29 {string match} { string match \[a a } 1 +test string-11.30 {string match, bad args} { + list [catch {string match - b c} msg] $msg +} {1 {bad option "-": must be -nocase}} +test string-11.31 {string match case} { + string match a A +} 0 +test string-11.32 {string match nocase} { + string match -n a A +} 1 +test string-11.33 {string match nocase} { + string match -nocase a\334 A\374 +} 1 +test string-11.34 {string match nocase} { + string match -nocase a*f ABCDEf +} 1 +test string-11.35 {string match case, false hope} { + # This is true because '_' lies between the A-Z and a-z ranges + string match {[A-z]} _ +} 1 +test string-11.36 {string match nocase range} { + # This is false because although '_' lies between the A-Z and a-z ranges, + # we lower case the end points before checking the ranges. + string match -nocase {[A-z]} _ +} 0 +test string-11.37 {string match nocase} { + string match -nocase {[A-fh-Z]} g +} 0 +test string-11.38 {string match case, reverse range} { + string match {[A-fh-Z]} g +} 1 test string-12.1 {string range} { list [catch {string range} msg] $msg |