diff options
author | hobbs <hobbs> | 1999-09-21 04:20:28 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-09-21 04:20:28 (GMT) |
commit | a583a768fbe40ec2b7d661fe32d8347a34632fcf (patch) | |
tree | 8063ba8ff9da4fa71559d95b2c2389d1a8b516c0 /tests | |
parent | 1f66507f55794f140cf5952e6d45da60c066c014 (diff) | |
download | tcl-a583a768fbe40ec2b7d661fe32d8347a34632fcf.zip tcl-a583a768fbe40ec2b7d661fe32d8347a34632fcf.tar.gz tcl-a583a768fbe40ec2b7d661fe32d8347a34632fcf.tar.bz2 |
1999-09-16 Jeff Hobbs <hobbs@scriptics.com>
* tests/timer.test: changed after delay in timer test 6.29 from
1 to 10. [Bug: 2796]
* tests/pkg.test:
* generic/tclPkg.c: fixed package version check to disallow 1.2..3
[Bug: 2539]
* unix/Makefile.in: fixed gendate target - this never worked
since RCS was intro'd.
* generic/tclGetDate.y: updated to reflect previous changes
to tclDate.c (leap year calc) and added CEST and UCT time zone
recognition. Fixed 4 missing UCHAR() casts. [Bug: 2717, 954,
1245, 1249]
* generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really
dump to stderr and close it [Bug: 725] and changed Tcl_Ckrealloc
and Tcl_Ckfree to not bomb when NULL was passed in [Bug: 1719]
and changed Tcl_Alloc, et al to not panic when a alloc request
for zero came through and NULL was returned (valid on AIX, Tru64)
[Bug: 2795, etc]
* tests/clock.test:
* doc/clock.n:
* generic/tclClock.c: added -milliseconds switch to clock clicks
to guarantee that the return value of clicks is in the millisecs
granularity [Bug: 2682, 1332]
1999-09-15 Jeff Hobbs <hobbs@scriptics.com>
* generic/tclIOCmd.c: fixed potential core dump in conjunction
with stacked channels with result obj manipulation in
Tcl_ReadChars [Bug: 2623]
* tests/format.test:
* generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605]
* doc/msgcat.n: fixed \\ bug in example [Bug: 2548]
* unix/tcl.m4:
* unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition
[Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610]
* doc/array.n:
* tests/var.test:
* tests/set.test:
* generic/tclVar.c: added an array unset operation, with docs
and tests. Variation of [Bug: 1775]. Added fix in TclArraySet
to check when trying to set in a non-existent namespace. [Bug: 2613]
1999-09-14 Jeff Hobbs <hobbs@scriptics.com>
* tests/linsert.test:
* doc/linsert.n:
* generic/tclCmdIL.c: fixed end-int interpretation of linsert
to correctly calculate value for end, added test and docs [Bug: 2693]
* doc/regexp.n:
* doc/regsub.n:
* tests/regexp.test:
* generic/tclCmdMZ.c: add -start switch to regexp and regsub
with docs and tests
* doc/switch.n: added proper use of comments to example.
* generic/tclCmdMZ.c: changed switch to complain when an error
occurs that seems to be due to a misplaced comment.
* generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions
in regsub [Bug: 2723]
* generic/tclCmdMZ.c: changed [string equal] to return an Int
type object (was a Boolean)
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} |