summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-09-21 04:20:28 (GMT)
committerhobbs <hobbs>1999-09-21 04:20:28 (GMT)
commita583a768fbe40ec2b7d661fe32d8347a34632fcf (patch)
tree8063ba8ff9da4fa71559d95b2c2389d1a8b516c0 /tests
parent1f66507f55794f140cf5952e6d45da60c066c014 (diff)
downloadtcl-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.test19
-rw-r--r--tests/format.test15
-rw-r--r--tests/linsert.test5
-rw-r--r--tests/pkg.test5
-rw-r--r--tests/regexp.test54
-rw-r--r--tests/set-old.test13
-rw-r--r--tests/timer.test4
-rw-r--r--tests/var.test20
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}