diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/clock.test | 19 | ||||
| -rw-r--r-- | tests/format.test | 15 | ||||
| -rw-r--r-- | tests/linsert.test | 5 | ||||
| -rw-r--r-- | tests/pkg.test | 5 | ||||
| -rw-r--r-- | tests/regexp.test | 54 | ||||
| -rw-r--r-- | tests/set-old.test | 13 | ||||
| -rw-r--r-- | tests/timer.test | 4 | ||||
| -rw-r--r-- | tests/var.test | 20 |
8 files changed, 120 insertions, 15 deletions
diff --git a/tests/clock.test b/tests/clock.test index d0192cd..1b1632f 100644 --- a/tests/clock.test +++ b/tests/clock.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: clock.test,v 1.4 1999/06/26 03:54:10 jenn Exp $ +# RCS: @(#) $Id: clock.test,v 1.5 1999/09/21 04:20:44 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -30,14 +30,25 @@ test clock-2.1 {clock clicks tests} { concat {} } {} test clock-2.2 {clock clicks tests} { - list [catch {clock clicks foo} msg] $msg -} {1 {wrong # args: should be "clock clicks"}} -test clock-2.3 {clock clicks tests} { set start [clock clicks] after 10 set end [clock clicks] expr "$end > $start" } {1} +test clock-2.3 {clock clicks tests} { + list [catch {clock clicks foo} msg] $msg +} {1 {bad switch "foo": must be -milliseconds}} +test clock-2.3 {clock clicks tests} { + expr [clock clicks -milliseconds]+1 + concat {} +} {} +test clock-2.2 {clock clicks tests, millisecond timing test} { + set start [clock clicks -milli] + after 10 + set end [clock clicks -milli] + # assume, even with slow interp'ing, the diff is less than 60 msecs + expr {($end > $start) && (($end - $start) < 60)} +} {1} # clock format test clock-3.1 {clock format tests} {unixOnly} { diff --git a/tests/format.test b/tests/format.test index 58f142f..3d3b88e 100644 --- a/tests/format.test +++ b/tests/format.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: format.test,v 1.6 1999/08/17 21:34:45 jenn Exp $ +# RCS: @(#) $Id: format.test,v 1.7 1999/09/21 04:20:44 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -467,6 +467,19 @@ test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} { format {%s} "a" } {a} +test format-15.1 {testing %0..s 0 padding for chars/strings} { + format %05s a +} {0000a} +test format-15.2 {testing %0..s 0 padding for chars/strings} { + format "% 5s" a +} { a} +test format-15.3 {testing %0..s 0 padding for chars/strings} { + format %5s a +} { a} +test format-15.4 {testing %0..s 0 padding for chars/strings} { + format %05c 61 +} {0000=} + set a "0123456789" set b "" for {set i 0} {$i < 290} {incr i} { diff --git a/tests/linsert.test b/tests/linsert.test index c1e42a6..1a1ee82 100644 --- a/tests/linsert.test +++ b/tests/linsert.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: linsert.test,v 1.6 1999/06/26 03:54:16 jenn Exp $ +# RCS: @(#) $Id: linsert.test,v 1.7 1999/09/21 04:20:44 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -78,6 +78,9 @@ test linsert-1.18 {linsert command} { test linsert-1.19 {linsert command} { linsert {} end q r } {q r} +test linsert-1.20 {linsert command, use of end-int index} { + linsert {a b c d} end-2 e f +} {a b e f c d} test linsert-2.1 {linsert errors} { list [catch linsert msg] $msg diff --git a/tests/pkg.test b/tests/pkg.test index 82cc7a5..806a5fb 100644 --- a/tests/pkg.test +++ b/tests/pkg.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: pkg.test,v 1.6 1999/06/26 20:55:09 rjohnson Exp $ +# RCS: @(#) $Id: pkg.test,v 1.7 1999/09/21 04:20:44 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -529,6 +529,9 @@ test pkg-5.3 {CheckVersion procedure} { test pkg-5.4 {CheckVersion procedure} { list [catch {package vcompare 1.2.3. 2.1} msg] $msg } {1 {expected version number but got "1.2.3."}} +test pkg-5.5 {CheckVersion procedure} { + list [catch {package vcompare 1.2..3 2.1} msg] $msg +} {1 {expected version number but got "1.2..3"}} test pkg-6.1 {ComparePkgVersions procedure} { package vcompare 1.23 1.22 diff --git a/tests/regexp.test b/tests/regexp.test index b0f101c..6bff015 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.9 1999/08/23 17:54:59 jenn Exp $ +# RCS: @(#) $Id: regexp.test,v 1.10 1999/09/21 04:20:45 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -190,7 +190,7 @@ test regexp-6.2 {regexp errors} { } {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}} test regexp-6.3 {regexp errors} { list [catch {regexp -gorp a} msg] $msg -} {1 {bad switch "-gorp": must be -indices, -nocase, -about, -expanded, -line, -linestop, -lineanchor, or --}} +} {1 {bad switch "-gorp": must be -indices, -nocase, -about, -expanded, -line, -linestop, -lineanchor, -start, or --}} test regexp-6.4 {regexp errors} { list [catch {regexp a( b} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} @@ -208,6 +208,9 @@ test regexp-6.8 {regexp errors} { set f1 44 list [catch {regexp abc abc f1(f2)} msg] $msg } {1 {couldn't set variable "f1(f2)"}} +test regexp-6.9 {regexp errors, -start bad int check} { + list [catch {regexp -start bogus {^$} {}} msg] $msg +} {1 {expected integer but got "bogus"}} test regexp-7.1 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo @@ -353,7 +356,7 @@ test regexp-11.4 {regsub errors} { } {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}} test regexp-11.5 {regsub errors} { list [catch {regsub -gorp a b c} msg] $msg -} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, or --}} +} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}} test regexp-11.6 {regsub errors} { list [catch {regsub -nocase a( b c d} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} @@ -362,6 +365,9 @@ test regexp-11.7 {regsub errors} { set f1 44 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } {1 {couldn't set variable "f1(f2)"}} +test regexp-11.8 {regsub errors, -start bad int check} { + list [catch {regsub -start bogus pattern string rep var} msg] $msg +} {1 {expected integer but got "bogus"}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... @@ -414,6 +420,48 @@ test regexp-14.3 {unixOrPc} {CompileRegexp: regexp cache, empty regexp and empty exec $::tcltest::tcltest junk.tcl } 1 +test regexp-15.1 {regexp -start} { + catch {unset x} + list [regexp -start -10 {\d} 1abc2de3 x] $x +} {1 1} +test regexp-15.2 {regexp -start} { + catch {unset x} + list [regexp -start 2 {\d} 1abc2de3 x] $x +} {1 2} +test regexp-15.3 {regexp -start} { + catch {unset x} + list [regexp -start 4 {\d} 1abc2de3 x] $x +} {1 2} +test regexp-15.4 {regexp -start} { + catch {unset x} + list [regexp -start 5 {\d} 1abc2de3 x] $x +} {1 3} +test regexp-15.5 {regexp -start, over end of string} { + catch {unset x} + list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] +} {0 0} +test regexp-15.6 {regexp -start, loss of ^$ behavior} { + list [regexp -start 2 {^$} {}] +} {0} + +test regexp-16.1 {regsub -start} { + catch {unset x} + list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x +} {4 a1b/2c/3d/4e/5} +test regexp-16.2 {regsub -start} { + catch {unset x} + list [regsub -all -start -25 {z} hello {/&} x] $x +} {0 hello} +test regexp-16.3 {regsub -start} { + catch {unset x} + list [regsub -all -start 3 {z} hello {/&} x] $x +} {0 hello} +test regexp-16.4 {regsub -start, \A behavior} { + set out {} + lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x + lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x +} {5 /a/b/c/d/e 3 ab/c/d/e} + set x 1 set y 2 regexp "$x$y" 123 diff --git a/tests/set-old.test b/tests/set-old.test index 7fec23e..02bc702 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: set-old.test,v 1.6 1999/06/26 20:55:12 rjohnson Exp $ +# RCS: @(#) $Id: set-old.test,v 1.7 1999/09/21 04:20:45 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -296,7 +296,7 @@ test set-old-8.6 {array command} { catch {unset a} set a(22) 3 list [catch {array gorp a} msg] $msg -} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, or startsearch}} +} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, or unset}} test set-old-8.7 {array command, anymore option} { catch {unset a} list [catch {array anymore a x} msg] $msg @@ -501,6 +501,15 @@ test set-old-8.37.4 {array command, empty set with populated array} { array set aVaRnAmE [list e3 v3] list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg } {{e1 e2 e3} 0 v2} +test set-old-8.37.5 {array command, set with non-existent namespace} { + list [catch {array set bogusnamespace::var {}} msg] $msg +} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} +test set-old-8.37.6 {array command, set with non-existent namespace} { + list [catch {array set bogusnamespace::var {a b}} msg] $msg +} {1 {can't set "bogusnamespace::var(a)": parent namespace doesn't exist}} +test set-old-8.37.7 {array command, set with non-existent namespace} { + list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg +} {1 {can't set "bogusnamespace::var(0)": variable isn't array}} test set-old-8.38 {array command, size option} { catch {unset a} array size a diff --git a/tests/timer.test b/tests/timer.test index 4a85cda..b9ed530 100644 --- a/tests/timer.test +++ b/tests/timer.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: timer.test,v 1.5 1999/06/26 20:55:15 rjohnson Exp $ +# RCS: @(#) $Id: timer.test,v 1.6 1999/09/21 04:20:45 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -412,7 +412,7 @@ test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} { } set x "hello world" set id junk - set id [after 1 set x ab\0cd] + set id [after 10 set x ab\0cd] update set y [string length [lindex [lindex [after info $id] 0] 2]] foreach i [after info] { diff --git a/tests/var.test b/tests/var.test index d9d0fe0..af962a8 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.8 1999/07/22 21:50:55 redman Exp $ +# RCS: @(#) $Id: var.test,v 1.9 1999/09/21 04:20:45 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -584,6 +584,24 @@ test var-10.2 {can't nest arrays with array set} { list [catch {array set arr(x) {}} res] $res } {1 {can't set "arr(x)": variable isn't array}} +test var-11.1 {array unset} { + catch {unset a} + array set a { 1,1 a 1,2 b 2,1 c 2,3 d } + array unset a 1,* + lsort -dict [array names a] +} {2,1 2,3} +test var-11.2 {array unset} { + catch {unset a} + array set a { 1,1 a 1,2 b } + array unset a + array exists a +} 0 +test var-11.3 {array unset errors} { + catch {unset a} + array set a { 1,1 a 1,2 b } + list [catch {array unset a pattern too} msg] $msg +} {1 {wrong # args: should be "array unset arrayName ?pattern?"}} + catch {namespace delete ns} catch {unset arr} catch {unset v} |