summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog9
-rw-r--r--tests/async.test70
-rw-r--r--tests/clock.test4
-rw-r--r--tests/compExpr-old.test41
-rw-r--r--tests/compExpr.test22
-rw-r--r--tests/exec.test10
-rw-r--r--tests/expr-old.test53
-rw-r--r--tests/expr.test28
-rw-r--r--tests/fCmd.test10
-rw-r--r--tests/fileName.test36
-rw-r--r--tests/format.test5
-rw-r--r--tests/info.test6
-rw-r--r--tests/interp.test148
-rw-r--r--tests/macOSXFCmd.test6
-rw-r--r--tests/obj.test183
-rw-r--r--tests/parseExpr.test407
-rw-r--r--tests/rename.test116
-rw-r--r--tests/safe.test62
-rw-r--r--tests/socket.test8
-rw-r--r--tests/string.test5
-rw-r--r--tests/stringComp.test5
-rw-r--r--tests/stringObj.test131
-rw-r--r--tests/thread.test8
-rw-r--r--tests/unixFCmd.test12
-rw-r--r--tests/unixFile.test23
-rw-r--r--tests/unixNotfy.test23
-rw-r--r--tests/util.test12
-rw-r--r--tests/var.test115
-rw-r--r--tests/winDde.test622
-rw-r--r--tests/winFCmd.test19
-rw-r--r--tests/winNotify.test5
-rw-r--r--tests/winPipe.test9
32 files changed, 986 insertions, 1227 deletions
diff --git a/ChangeLog b/ChangeLog
index e634d40..6aa673c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-05-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/*.test: Many minor fixes, including ensuring that every
+ test is run (so constraints control whether the test is doing
+ anything) and making sure that constraints are always set using
+ the API instead of poking around inside tcltest's internal
+ datastructures. Also got rid of all trailing whitespace lines
+ from the test suite!
+
2004-05-19 Andreas Kupries <andreask@activestate.com>
* tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem as
diff --git a/tests/async.test b/tests/async.test
index 863be98..969208c 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -11,19 +11,14 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: async.test,v 1.7 2003/11/16 00:49:20 dkf Exp $
+# RCS: @(#) $Id: async.test,v 1.8 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-if {[info commands testasync] == {}} {
- puts "This application hasn't been compiled with the \"testasync\""
- puts "command, so I can't test Tcl_AsyncCreate et al."
- ::tcltest::cleanupTests
- return
-}
+testConstraint testasync [llength [info commands testasync]]
tcltest::testConstraint threaded [expr {
[info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
@@ -53,43 +48,45 @@ proc \# {result code} {
return "comment quoting"
}
-set handler1 [testasync create async1]
-set handler2 [testasync create async2]
-set handler3 [testasync create async3]
-set handler4 [testasync create #]
-test async-1.1 {basic async handlers} {
+if {[testConstraint testasync]} {
+ set handler1 [testasync create async1]
+ set handler2 [testasync create async2]
+ set handler3 [testasync create async3]
+ set handler4 [testasync create \#]
+}
+test async-1.1 {basic async handlers} testasync {
set aresult xxx
set acode yyy
list [catch {testasync mark $handler1 "original" 0} msg] $msg \
$acode $aresult
} {0 {new result} 0 original}
-test async-1.2 {basic async handlers} {
+test async-1.2 {basic async handlers} testasync {
set aresult xxx
set acode yyy
list [catch {testasync mark $handler1 "original" 1} msg] $msg \
$acode $aresult
} {0 {new result} 1 original}
-test async-1.3 {basic async handlers} {
+test async-1.3 {basic async handlers} testasync {
set aresult xxx
set acode yyy
list [catch {testasync mark $handler2 "old" 0} msg] $msg \
$acode $aresult
} {1 xyzzy 0 old}
-test async-1.4 {basic async handlers} {
+test async-1.4 {basic async handlers} testasync {
set aresult xxx
set acode yyy
list [catch {testasync mark $handler2 "old" 3} msg] $msg \
$acode $aresult
} {1 xyzzy 3 old}
-test async-1.5 {basic async handlers} {
+test async-1.5 {basic async handlers} testasync {
set aresult xxx
list [catch {testasync mark $handler3 "foobar" 0} msg] $msg $aresult
} {0 foobar {test pattern}}
-test async-1.6 {basic async handlers} {
+test async-1.6 {basic async handlers} testasync {
set aresult xxx
list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult
} {1 foobar {test pattern}}
-test async-1.7 {basic async handlers} {
+test async-1.7 {basic async handlers} testasync {
set aresult xxx
set acode yyy
list [catch {testasync mark $handler4 "original" 0} msg] $msg \
@@ -101,13 +98,11 @@ proc mult1 {result code} {
lappend x mult1
return -code 7 mult1
}
-set hm1 [testasync create mult1]
proc mult2 {result code} {
global x
lappend x mult2
return -code 9 mult2
}
-set hm2 [testasync create mult2]
proc mult3 {result code} {
global x hm1 hm2
lappend x [catch {testasync mark $hm2 serial2 0}]
@@ -115,9 +110,12 @@ proc mult3 {result code} {
lappend x mult3
return -code 11 mult3
}
-set hm3 [testasync create mult3]
-
-test async-2.1 {multiple handlers} {
+if {[testConstraint testasync]} {
+ set hm1 [testasync create mult1]
+ set hm2 [testasync create mult2]
+ set hm3 [testasync create mult3]
+}
+test async-2.1 {multiple handlers} testasync {
set x {}
list [catch {testasync mark $hm3 "foobar" 5} msg] $msg $x
} {9 mult2 {0 0 mult3 mult1 mult2}}
@@ -138,14 +136,16 @@ proc del2 {result code} {
lappend x del2
return -code 3 del2
}
-testasync delete $handler1
-testasync delete $hm2
-testasync delete $hm3
-set hm2 [testasync create del1]
-set hm3 [testasync create mult2]
-set hm4 [testasync create del2]
+if {[testConstraint testasync]} {
+ testasync delete $handler1
+ testasync delete $hm2
+ testasync delete $hm3
+ set hm2 [testasync create del1]
+ set hm3 [testasync create mult2]
+ set hm4 [testasync create del2]
+}
-test async-3.1 {deleting handlers} {
+test async-3.1 {deleting handlers} testasync {
set x {}
list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}
@@ -183,7 +183,7 @@ proc hang3 {handle} [concat {
}]
test async-4.1 {async interrupting bytecode sequence} -constraints {
- threaded
+ testasync threaded
} -setup {
set hm [testasync create async3]
} -body {
@@ -192,7 +192,7 @@ test async-4.1 {async interrupting bytecode sequence} -constraints {
testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
- threaded
+ testasync threaded
} -setup {
set hm [testasync create async3]
} -body {
@@ -201,7 +201,7 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
- threaded
+ testasync threaded
} -setup {
set hm [testasync create async3]
} -body {
@@ -211,7 +211,9 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
}
# cleanup
-testasync delete
+if {[testConstraint testasync]} {
+ testasync delete
+}
::tcltest::cleanupTests
return
diff --git a/tests/clock.test b/tests/clock.test
index f93e698..9946009 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.27 2004/05/18 21:45:55 kennykb Exp $
+# RCS: @(#) $Id: clock.test,v 1.28 2004/05/19 20:15:31 dkf Exp $
set env(LC_TIME) POSIX
@@ -508,7 +508,7 @@ test clock-8.1 {clock scan midnight/gmt range bug 413397} {
[clock format [clock scan year -base $5amPST -gmt 1] -format $fmt]
} {12/31 12/31}
-set ::tcltest::testConstraints(needPST) [expr {
+testConstraint needPST [expr {
[regexp {^(Pacific.*|P[DS]T)$} [clock format 1 -format %Z]]
&& ([clock format 1 -format %s] != "%s")
}]
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index 2c9b778..b3e0677 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: compExpr-old.test,v 1.8 2003/09/12 23:55:34 dkf Exp $
+# RCS: @(#) $Id: compExpr-old.test,v 1.9 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -20,11 +20,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
- set gotT1 0
- puts "This application hasn't been compiled with the \"T1\" and"
- puts "\"T2\" math functions, so I'll skip some of the expr tests."
+ testConstraint testmathfunctions 0
} else {
- set gotT1 1
+ testConstraint testmathfunctions 1
}
# procedures used below
@@ -600,24 +598,21 @@ test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} {
} {syntax error in expression "sin(1": missing close parenthesis at end of function call
while compiling
"expr sin(1"}
-if $gotT1 {
- test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} {
- expr 2*T1()
- } 246
- test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} {
- expr T2()*3
- } 1035
-
- test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} {
- expr T3(21, 37)
- } 37
- test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} {
- expr T3(21.2, 37)
- } 37.0
- test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} {
- expr T3(-21.2, -17.5)
- } -17.5
-}
+test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr 2*T1()
+} 246
+test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr T2()*3
+} 1035
+test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr T3(21, 37)
+} 37
+test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr T3(21.2, 37)
+} 37.0
+test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr T3(-21.2, -17.5)
+} -17.5
test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
diff --git a/tests/compExpr.test b/tests/compExpr.test
index cd407d3..4470fef 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: compExpr.test,v 1.6 2001/12/06 10:59:17 dkf Exp $
+# RCS: @(#) $Id: compExpr.test,v 1.7 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -16,11 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
- set gotT1 0
- puts "This application hasn't been compiled with the \"T1\" and"
- puts "\"T2\" math functions, so I'll skip some of the expr tests."
+ testConstraint testmathfunctions 0
} else {
- set gotT1 1
+ testConstraint testmathfunctions 1
}
catch {unset a}
@@ -294,14 +292,12 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} {
list [catch {expr {do_it()}} msg] $msg
} {1 {unknown math function "do_it"}}
-if $gotT1 {
- test compExpr-5.3 {CompileMathFuncCall: call registered math function} {
- expr 3*T1()-1
- } 368
- test compExpr-5.4 {CompileMathFuncCall: call registered math function} {
- expr T2()*3
- } 1035
-}
+test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr 3*T1()-1
+} 368
+test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions {
+ expr T2()*3
+} 1035
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} {
list [catch {expr {atan2(1.0)}} msg] $msg
} {1 {too few arguments for math function}}
diff --git a/tests/exec.test b/tests/exec.test
index 18060f6..8d338ca 100644
--- a/tests/exec.test
+++ b/tests/exec.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: exec.test,v 1.18 2004/02/25 23:56:59 dgp Exp $
+# RCS: @(#) $Id: exec.test,v 1.19 2004/05/19 20:15:31 dkf Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -217,8 +217,8 @@ test exec-4.5 {redirecting output and stderr to file} {exec} {
# I/O redirection: input from file.
-if { [set ::tcltest::testConstraints(exec)] } {
-exec [interpreter] $path(echo) "Just a few thoughts" > $path(gorp.file)
+if {[testConstraint exec]} {
+ exec [interpreter] $path(echo) "Just a few thoughts" > $path(gorp.file)
}
test exec-5.1 {redirecting input from file} {exec} {
exec [interpreter] $path(cat) < $path(gorp.file)
@@ -428,8 +428,8 @@ test exec-11.5 {commands in background} {exec} {
# Make sure that background commands are properly reaped when
# they eventually die.
-if { [set ::tcltest::testConstraints(exec)] } {
-exec [interpreter] $path(sleep) 3
+if {[testConstraint exec]} {
+ exec [interpreter] $path(sleep) 3
}
test exec-12.1 {reaping background processes} \
{exec unixOnly nonPortable} {
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 2df8135..1d7b796 100644
--- a/tests/expr-old.test
+++ b/tests/expr-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: expr-old.test,v 1.17 2003/03/27 13:48:58 dkf Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.18 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -21,11 +21,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
- set gotT1 0
- puts "This application hasn't been compiled with the \"T1\" and"
- puts "\"T2\" math functions, so I'll skip some of the expr tests."
+ testConstraint testmathfunctions 0
} else {
- set gotT1 1
+ testConstraint testmathfunctions 1
}
# First, test all of the integer operators individually.
@@ -732,11 +730,11 @@ test expr-old-32.24 {math functions in expressions} {
# The following test is different for 32-bit versus 64-bit architectures.
if {0x80000000 > 0} {
- test expr-old-32.25 {math functions in expressions} {nonPortable} {
+ test expr-old-32.25a {math functions in expressions} {nonPortable} {
list [catch {expr abs(0x8000000000000000)} msg] $msg
} {1 {integer value too large to represent}}
} else {
- test expr-old-32.25 {math functions in expressions} {nonPortable} {
+ test expr-old-32.25b {math functions in expressions} {nonPortable} {
list [catch {expr abs(0x80000000)} msg] $msg
} {1 {integer value too large to represent}}
}
@@ -792,14 +790,12 @@ test expr-old-32.41 {math functions in expressions} {
test expr-old-32.42 {math functions in expressions} {
list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
-if $gotT1 {
- test expr-old-32.43 {math functions in expressions} {
- expr 2*T1()
- } 246
- test expr-old-32.44 {math functions in expressions} {
- expr T2()*3
- } 1035
-}
+test expr-old-32.43 {math functions in expressions} testmathfunctions {
+ expr 2*T1()
+} 246
+test expr-old-32.44 {math functions in expressions} testmathfunctions {
+ expr T2()*3
+} 1035
test expr-old-32.45 {math functions in expressions} {
expr (0 <= rand()) && (rand() < 1)
} {1}
@@ -893,11 +889,9 @@ test expr-old-34.15 {errors in math functions} {
test expr-old-34.16 {errors in math functions} {
list [catch {expr round(-1.0e30)} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-if $gotT1 {
- test expr-old-34.17 {errors in math functions} {
- list [catch {expr T1(4)} msg] $msg
- } {1 {too many arguments for math function}}
-}
+test expr-old-34.17 {errors in math functions} testmathfunctions {
+ list [catch {expr T1(4)} msg] $msg
+} {1 {too many arguments for math function}}
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
expr 0289
@@ -963,24 +957,17 @@ test expr-old-36.16 {ExprLooksLikeInt procedure} {
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use integer value too large to represent as operand of "+"}}
-if {[info commands testexprlong] == {}} {
- puts "This application hasn't been compiled with the \"testexprlong\""
- puts "command, so I can't test Tcl_ExprLong etc."
-} else {
-test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} {
+testConstraint testexprlong [llength [info commands testexprlong]]
+testConstraint testexprstring [llength [info commands testexprstring]]
+
+test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
testexprlong
} {This is a result: 5}
-}
-if {[info commands testexprstring] == {}} {
- puts "This application hasn't been compiled with the \"testexprstring\""
- puts "command, so I can't test Tcl_ExprString etc."
-} else {
-test expr-old-38.1 {Verify Tcl_ExprString's basic operation} {
+test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring {
list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
- [catch {testexprstring "1+"} msg] $msg
+ [catch {testexprstring "1+"} msg] $msg
} {5 10.2 1 {syntax error in expression "1+": premature end of expression}}
-}
# Special test for Pentium arithmetic bug of 1994:
diff --git a/tests/expr.test b/tests/expr.test
index 0b2543e..9a168c9 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,14 +10,14 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr.test,v 1.20 2003/09/19 23:05:40 dkf Exp $
+# RCS: @(#) $Id: expr.test,v 1.21 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-testConstraint registeredMathFuncs [expr {
+testConstraint testmathfunctions [expr {
([catch {expr T1()} msg] != 1) || ($msg ne {unknown math function "T1"})
}]
@@ -324,11 +324,11 @@ test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
# architectures because LONG_MIN is different
if {0x80000000 > 0} {
- test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+ test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
expr {1<<63}
} -9223372036854775808
} else {
- test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+ test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
expr {1<<31}
} -2147483648
}
@@ -626,34 +626,34 @@ test expr-15.6 {CompileMathFuncCall: missing ')'} {
} {syntax error in expression "sin(1": missing close parenthesis at end of function call
while compiling
"expr sin(1"}
-test expr-15.7 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr 2*T1()
} 246
-test expr-15.8 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr T2()*3
} 1035
-test expr-15.9 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr T3(21, 37)
} 37
-test expr-15.10 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr T3(21.2, 37)
} 37.0
-test expr-15.11 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr T3(-21.2, -17.5)
} -17.5
-test expr-15.12 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(21, wide(37))
} 37
-test expr=15.13 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(wide(21), 37)
} 37
-test expr=15.14 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(wide(21), wide(37))
} 37
-test expr-15.15 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(21.0, wide(37))
} 37.0
-test expr=15.16 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+test expr=15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(wide(21), 37.0)
} 37.0
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 9e1b3e6..fbf2216 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.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: fCmd.test,v 1.38 2004/03/17 18:14:17 das Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.39 2004/05/19 20:15:31 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -92,17 +92,17 @@ proc contents {file} {
}
cd [temporaryDirectory]
-set ::tcltest::testConstraints(fileSharing) 0
-set ::tcltest::testConstraints(notFileSharing) 1
+testConstraint fileSharing 0
+testConstraint notFileSharing 1
-set ::tcltest::testConstraints(xdev) 0
+testConstraint xdev 0
if {$tcl_platform(platform) == "unix"} {
if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
- set ::tcltest::testConstraints(xdev) 1
+ testConstraint xdev 1
}
}
}
diff --git a/tests/fileName.test b/tests/fileName.test
index ae900af..a5f077d 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -10,18 +10,18 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: fileName.test,v 1.41 2004/05/04 22:31:10 hobbs Exp $
+# RCS: @(#) $Id: fileName.test,v 1.42 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
-tcltest::testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
+testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
+testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
global env
-if {[tcltest::testConstraint testsetplatform]} {
+if {[testConstraint testsetplatform]} {
set platform [testgetplatform]
}
@@ -204,7 +204,7 @@ test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
file split foo/bar~/baz
} {foo bar~ baz}
-if {[tcltest::testConstraint testsetplatform]} {
+if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
@@ -662,7 +662,7 @@ test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
list [catch {testtranslatefilename foo//bar} msg] $msg
} {0 {foo\bar}}
-if {[tcltest::testConstraint testsetplatform]} {
+if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
@@ -721,7 +721,7 @@ test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
set x
} {1 {couldn't find HOME environment variable to expand path}}
-if {[tcltest::testConstraint testsetplatform]} {
+if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
@@ -781,17 +781,17 @@ test filename-11.17.1 {Tcl_GlobCmd} {pcOnly} {
if {[string equal $tcl_platform(platform) "windows"]} {
if {[string index $tcl_platform(osVersion) 0] >= 5 \
&& ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
- tcltest::testConstraint linkDirectory 1
+ testConstraint linkDirectory 1
} else {
- tcltest::testConstraint linkDirectory 0
+ testConstraint linkDirectory 0
}
} else {
- tcltest::testConstraint linkDirectory 1
+ testConstraint linkDirectory 1
}
if {[string equal $tcl_platform(platform) "windows"]} {
- tcltest::testConstraint symbolicLinkFile 0
+ testConstraint symbolicLinkFile 0
} else {
- tcltest::testConstraint symbolicLinkFile 1
+ testConstraint symbolicLinkFile 1
}
test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
set dir [pwd]
@@ -1409,7 +1409,7 @@ test filename-15.8 {win and unix specific globbing} {unixOrWin} {
# The following tests are only valid for Windows systems.
set oldDir [pwd]
-if {$::tcltest::testConstraints(pcOnly)} {
+if {[testConstraint pcOnly]} {
cd c:/
file delete -force globTest
file mkdir globTest
@@ -1461,10 +1461,8 @@ test filename-16.11 {windows specific globbing} {pcOnly} {
# some tests require a shared C drive
-if {[catch {cd //[info hostname]/c}]} {
- set ::tcltest::testConstraints(sharedCdrive) 0
-} else {
- set ::tcltest::testConstraints(sharedCdrive) 1
+if {[testConstraint pcOnly]} {
+ testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
test filename-16.12 {windows specific globbing} {pcOnly sharedCdrive} {
@@ -1493,7 +1491,7 @@ test filename-17.1 {windows specific special files} {testsetplatform} {
[file pathtype prn] [file pathtype nul] [file pathtype aux] \
[file pathtype foo]
} {absolute absolute absolute absolute absolute absolute relative}
-if {[tcltest::testConstraint testsetplatform]} {
+if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
@@ -1515,7 +1513,7 @@ cd [temporaryDirectory]
file delete -force globTest
cd $oldpwd
set env(HOME) $oldhome
-if {[tcltest::testConstraint testsetplatform]} {
+if {[testConstraint testsetplatform]} {
testsetplatform $platform
catch {unset platform}
}
diff --git a/tests/format.test b/tests/format.test
index c6d9731..774fd1e 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.16 2003/05/14 23:04:32 dkf Exp $
+# RCS: @(#) $Id: format.test,v 1.17 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -22,8 +22,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# fail. Someday I hope this code shouldn't be necessary (code added
# 9/9/91).
-set ::tcltest::testConstraints(roundOffBug) \
- [expr {"[format %7.1e 68.514]" != "6.8e+01"}]
+testConstraint roundOffBug [expr {"[format %7.1e 68.514]" != "6.8e+01"}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
diff --git a/tests/info.test b/tests/info.test
index ec77d0b..e95fca2 100644
--- a/tests/info.test
+++ b/tests/info.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: info.test,v 1.26 2004/05/17 21:42:34 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.27 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -491,8 +491,7 @@ test info-15.7 {info procs option with a global shadowing proc} {
# This regression test is currently commented out because it requires
# that the implementation of "info procs" looks into the global namespace,
# which it does not (in contrast to "info commands")
-if {0} {
-test info-15.8 {info procs option with a global shadowing proc} {
+test info-15.8 {info procs option with a global shadowing proc} knownBug {
catch {namespace delete test_ns_info2}
proc string_cmd { arg } {
puts cmd
@@ -509,7 +508,6 @@ test info-15.8 {info procs option with a global shadowing proc} {
lsort [info procs string*]
}
} [lsort [list string_cmd string_cmd2]]
-}
test info-16.1 {info script option} {
list [catch {info script x x} msg] $msg
diff --git a/tests/interp.test b/tests/interp.test
index ace4ad7..8e84db0 100644
--- a/tests/interp.test
+++ b/tests/interp.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: interp.test,v 1.31 2004/05/18 09:29:30 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.32 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -674,85 +674,81 @@ test interp-17.5 {alias loop prevention} {
# the bugs as a core dump.
#
-if {[info commands testinterpdelete] == ""} {
- puts "This application hasn't been compiled with the \"testinterpdelete\""
- puts "command, so I can't test slave delete calls"
-} else {
- test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
- list [catch {testinterpdelete} msg] $msg
- } {1 {wrong # args: should be "testinterpdelete path"}}
- test interp-18.2 {testing Tcl_DeleteInterp vs slaves} {
- catch {interp delete a}
- interp create a
- testinterpdelete a
- } ""
- test interp-18.3 {testing Tcl_DeleteInterp vs slaves} {
- catch {interp delete a}
- interp create a
- interp create {a b}
- testinterpdelete {a b}
- } ""
- test interp-18.4 {testing Tcl_DeleteInterp vs slaves} {
- catch {interp delete a}
- interp create a
- interp create {a b}
- testinterpdelete a
- } ""
- test interp-18.5 {testing Tcl_DeleteInterp vs slaves} {
- catch {interp delete a}
- interp create a
- interp create {a b}
- interp alias {a b} dodel {} dodel
- proc dodel {x} {testinterpdelete $x}
- list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
- } {0 {}}
- test interp-18.6 {testing Tcl_DeleteInterp vs slaves} {
- catch {interp delete a}
- interp create a
- interp create {a b}
- interp alias {a b} dodel {} dodel
- proc dodel {x} {testinterpdelete $x}
- list [catch {interp eval {a b} {dodel a}} msg] $msg
- } {0 {}}
- test interp-18.7 {eval in deleted interp} {
- catch {interp delete a}
- interp create a
- a eval {
+testCosntraint testinterpdelete [llength [info commands testinterpdelete]]
+test interp-18.1 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+ list [catch {testinterpdelete} msg] $msg
+} {1 {wrong # args: should be "testinterpdelete path"}}
+test interp-18.2 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+ catch {interp delete a}
+ interp create a
+ testinterpdelete a
+} ""
+test interp-18.3 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+ catch {interp delete a}
+ interp create a
+ interp create {a b}
+ testinterpdelete {a b}
+} ""
+test interp-18.4 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+ catch {interp delete a}
+ interp create a
+ interp create {a b}
+ testinterpdelete a
+} ""
+test interp-18.5 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+ catch {interp delete a}
+ interp create a
+ interp create {a b}
+ interp alias {a b} dodel {} dodel
+ proc dodel {x} {testinterpdelete $x}
+ list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
+} {0 {}}
+test interp-18.6 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+ catch {interp delete a}
+ interp create a
+ interp create {a b}
+ interp alias {a b} dodel {} dodel
+ proc dodel {x} {testinterpdelete $x}
+ list [catch {interp eval {a b} {dodel a}} msg] $msg
+} {0 {}}
+test interp-18.7 {eval in deleted interp} {
+ catch {interp delete a}
+ interp create a
+ a eval {
+ proc dodel {} {
+ delme
+ dosomething else
+ }
+ proc dosomething args {
+ puts "I should not have been called!!"
+ }
+ }
+ a alias delme dela
+ proc dela {} {interp delete a}
+ list [catch {a eval dodel} msg] $msg
+} {1 {attempt to call eval in deleted interpreter}}
+test interp-18.8 {eval in deleted interp} {
+ catch {interp delete a}
+ interp create a
+ a eval {
+ interp create b
+ b eval {
proc dodel {} {
- delme
- dosomething else
- }
- proc dosomething args {
- puts "I should not have been called!!"
+ dela
}
}
- a alias delme dela
- proc dela {} {interp delete a}
- list [catch {a eval dodel} msg] $msg
- } {1 {attempt to call eval in deleted interpreter}}
- test interp-18.8 {eval in deleted interp} {
- catch {interp delete a}
- interp create a
- a eval {
- interp create b
- b eval {
- proc dodel {} {
- dela
- }
- }
- proc foo {} {
- b eval dela
- dosomething else
- }
- proc dosomething args {
- puts "I should not have been called!!"
- }
+ proc foo {} {
+ b eval dela
+ dosomething else
}
- interp alias {a b} dela {} dela
- proc dela {} {interp delete a}
- list [catch {a eval foo} msg] $msg
- } {1 {attempt to call eval in deleted interpreter}}
-}
+ proc dosomething args {
+ puts "I should not have been called!!"
+ }
+ }
+ interp alias {a b} dela {} dela
+ proc dela {} {interp delete a}
+ list [catch {a eval foo} msg] $msg
+} {1 {attempt to call eval in deleted interpreter}}
test interp-18.9 {eval in deleted interp, bug 495830} {
interp create tst
interp alias tst suicide {} interp delete tst
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
index 0bc6d30..2250435 100644
--- a/tests/macOSXFCmd.test
+++ b/tests/macOSXFCmd.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: macOSXFCmd.test,v 1.1 2003/05/14 19:21:25 das Exp $
+# RCS: @(#) $Id: macOSXFCmd.test,v 1.2 2004/05/19 20:15:32 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -23,14 +23,14 @@ set oldcwd [pwd]
cd [temporaryDirectory]
# check whether macosx file attributes are supported
-set ::tcltest::testConstraints(macosxFileAttr) 0
+testConstraint macosxFileAttr 0
if {$tcl_platform(platform) eq "unix" && \
$tcl_platform(os) eq "Darwin"} {
catch {file delete -force -- foo.test}
close [open foo.test w]
catch {
file attributes foo.test -creator
- set ::tcltest::testConstraints(macosxFileAttr) 1
+ testConstraint macosxFileAttr 1
}
file delete -force -- foo.test
}
diff --git a/tests/obj.test b/tests/obj.test
index c4ec7d4..a6bb192 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -11,21 +11,16 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: obj.test,v 1.7 2002/04/26 08:43:38 dkf Exp $
+# RCS: @(#) $Id: obj.test,v 1.8 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testobj\""
- puts "command, so I can't test the Tcl type and object support."
- ::tcltest::cleanupTests
- return
-}
+testConstraint testobj [llength [info commands testobj]]
-test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
+test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
set r 1
foreach {t} {
{array search}
@@ -47,7 +42,7 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
set result $r
} {1}
-test obj-2.1 {Tcl_GetObjType error} {
+test obj-2.1 {Tcl_GetObjType error} testobj {
list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
} {0 1 {no type foo found}}
test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
@@ -59,14 +54,14 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
lappend result [testobj refcount 1]
} {{} 12 12 double 3}
-test obj-3.1 {Tcl_ConvertToType error} {
+test obj-3.1 {Tcl_ConvertToType error} testobj {
list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
} {12.34 1 {expected integer but got "12.34"}}
-test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
+test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
} {{} 1 {expected integer but got ""}}
-test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
+test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -74,7 +69,7 @@ test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
lappend result [testobj refcount 1]
} {{} {} string 2}
-test obj-5.1 {Tcl_FreeObj} {
+test obj-5.1 {Tcl_FreeObj} testobj {
set result ""
lappend result [testintobj set 1 12345]
lappend result [testobj freeallvars]
@@ -82,7 +77,7 @@ test obj-5.1 {Tcl_FreeObj} {
lappend result $msg
} {12345 {} 1 {variable 1 is unset (NULL)}}
-test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
+test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 47]
@@ -91,7 +86,7 @@ test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
lappend result [testobj refcount 1]
lappend result [testobj refcount 2]
} {{} 47 47 47 2 3}
-test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
+test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -101,55 +96,57 @@ test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
lappend result [testobj refcount 2]
} {{} {} {} {} 2 3}
-test obj-7.1 {Tcl_GetString, return existing string rep} {
+# We assume that testobj is an indicator for test*obj as well
+
+test obj-7.1 {Tcl_GetString, return existing string rep} testobj {
set result ""
lappend result [testintobj set 1 47]
lappend result [testintobj get2 1]
} {47 47}
-test obj-7.2 {Tcl_GetString, "empty string" object} {
+test obj-7.2 {Tcl_GetString, "empty string" object} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [teststringobj append 1 abc -1]
lappend result [teststringobj get2 1]
} {{} abc abc}
-test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
+test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} testobj {
set result ""
lappend result [teststringobj set 1 xyz]
lappend result [teststringobj append 1 abc -1]
lappend result [teststringobj get2 1]
} {xyz xyzabc xyzabc}
-test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
+test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} testobj {
set result ""
lappend result [testintobj set 1 77]
lappend result [testintobj mult10 1]
lappend result [teststringobj get2 1]
} {77 770 770}
-test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
+test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} testobj {
set result ""
lappend result [testintobj set 1 47]
lappend result [testintobj get 1]
} {47 47}
-test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
+test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [teststringobj append 1 abc -1]
lappend result [teststringobj get 1]
} {{} abc abc}
-test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
+test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} testobj {
set result ""
lappend result [teststringobj set 1 xyz]
lappend result [teststringobj append 1 abc -1]
lappend result [teststringobj get 1]
} {xyz xyzabc xyzabc}
-test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
+test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} testobj {
set result ""
lappend result [testintobj set 1 77]
lappend result [testintobj mult10 1]
lappend result [teststringobj get 1]
} {77 770 770}
-test obj-9.1 {Tcl_NewBooleanObj} {
+test obj-9.1 {Tcl_NewBooleanObj} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testbooleanobj set 1 0]
@@ -157,7 +154,7 @@ test obj-9.1 {Tcl_NewBooleanObj} {
lappend result [testobj refcount 1]
} {{} 0 boolean 2}
-test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
+test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -165,7 +162,7 @@ test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 0 boolean 2}
-test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
+test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 98765]
@@ -174,62 +171,62 @@ test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 98765 1 boolean 2}
-test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
+test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} testobj {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testbooleanobj not 1] ;# gets existing boolean rep
} {1 0}
-test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
+test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} testobj {
set result ""
lappend result [testintobj set 1 47]
lappend result [testbooleanobj not 1] ;# must convert to bool
lappend result [testobj type 1]
} {47 0 boolean}
-test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
+test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {abc 1 {expected boolean value but got "abc"}}
-test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
+test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
-test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
+test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} testobj {
set result ""
lappend result [teststringobj set 1 0xac]
lappend result [testbooleanobj not 1]
lappend result [testobj type 1]
} {0xac 0 boolean}
-test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
+test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} testobj {
set result ""
lappend result [teststringobj set 1 5.42]
lappend result [testbooleanobj not 1]
lappend result [testobj type 1]
} {5.42 0 boolean}
-test obj-12.1 {DupBooleanInternalRep} {
+test obj-12.1 {DupBooleanInternalRep} testobj {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep
lappend result [testbooleanobj get 2]
} {1 1 1}
-test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
+test obj-13.1 {SetBooleanFromAny, int to boolean special case} testobj {
set result ""
lappend result [testintobj set 1 1234]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
} {1234 0 boolean}
-test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
+test obj-13.2 {SetBooleanFromAny, double to boolean special case} testobj {
set result ""
lappend result [testdoubleobj set 1 3.14159]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
} {3.14159 0 boolean}
-test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
+test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} testobj {
set result ""
foreach s {yes no true false on off} {
teststringobj set 1 $s
@@ -237,46 +234,46 @@ test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
}
lappend result [testobj type 1]
} {0 1 0 1 0 1 boolean}
-test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
+test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} testobj {
set result ""
lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
} {456 45 0 boolean}
-test obj-13.5 {SetBooleanFromAny, error parsing string} {
+test obj-13.5 {SetBooleanFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {abc 1 {expected boolean value but got "abc"}}
-test obj-13.6 {SetBooleanFromAny, error parsing string} {
+test obj-13.6 {SetBooleanFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 x1.0]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {x1.0 1 {expected boolean value but got "x1.0"}}
-test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
+test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
-test obj-13.8 {SetBooleanFromAny, unicode strings} {
+test obj-13.8 {SetBooleanFromAny, unicode strings} testobj {
set result ""
lappend result [teststringobj set 1 1\u7777]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"
-test obj-14.1 {UpdateStringOfBoolean} {
+test obj-14.1 {UpdateStringOfBoolean} testobj {
set result ""
lappend result [testbooleanobj set 1 0]
lappend result [testbooleanobj not 1]
lappend result [testbooleanobj get 1] ;# must update string rep
} {0 1 1}
-test obj-15.1 {Tcl_NewDoubleObj} {
+test obj-15.1 {Tcl_NewDoubleObj} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 3.1459]
@@ -284,7 +281,7 @@ test obj-15.1 {Tcl_NewDoubleObj} {
lappend result [testobj refcount 1]
} {{} 3.1459 double 2}
-test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
+test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -292,7 +289,7 @@ test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 0.123 double 2}
-test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
+test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 98765]
@@ -301,83 +298,83 @@ test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 98765 27.56 double 2}
-test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} {
+test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} testobj {
set result ""
lappend result [testdoubleobj set 1 16.1]
lappend result [testdoubleobj mult10 1] ;# gets existing double rep
} {16.1 161.0}
-test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} {
+test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} testobj {
set result ""
lappend result [testintobj set 1 477]
lappend result [testdoubleobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47.7 double}
-test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} {
+test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testdoubleobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected floating-point number but got "abc"}}
-test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
+test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testdoubleobj div10 1} msg]
lappend result $msg
} {{} 1 {expected floating-point number but got ""}}
-test obj-18.1 {DupDoubleInternalRep} {
+test obj-18.1 {DupDoubleInternalRep} testobj {
set result ""
lappend result [testdoubleobj set 1 17.1]
lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep
lappend result [testdoubleobj get 2]
} {17.1 17.1 17.1}
-test obj-19.1 {SetDoubleFromAny, int to double special case} {
+test obj-19.1 {SetDoubleFromAny, int to double special case} testobj {
set result ""
lappend result [testintobj set 1 1234]
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
lappend result [testobj type 1]
} {1234 12340.0 double}
-test obj-19.2 {SetDoubleFromAny, boolean to double special case} {
+test obj-19.2 {SetDoubleFromAny, boolean to double special case} testobj {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
lappend result [testobj type 1]
} {1 10.0 double}
-test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} {
+test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} testobj {
set result ""
lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
lappend result [testobj type 1]
} {456 45 450.0 double}
-test obj-19.4 {SetDoubleFromAny, error parsing string} {
+test obj-19.4 {SetDoubleFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testdoubleobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected floating-point number but got "abc"}}
-test obj-19.5 {SetDoubleFromAny, error parsing string} {
+test obj-19.5 {SetDoubleFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 x1.0]
lappend result [catch {testdoubleobj mult10 1} msg]
lappend result $msg
} {x1.0 1 {expected floating-point number but got "x1.0"}}
-test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} {
+test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testdoubleobj div10 1} msg]
lappend result $msg
} {{} 1 {expected floating-point number but got ""}}
-test obj-20.1 {UpdateStringOfDouble} {
+test obj-20.1 {UpdateStringOfDouble} testobj {
set result ""
lappend result [testdoubleobj set 1 3.14159]
lappend result [testdoubleobj mult10 1]
lappend result [testdoubleobj get 1] ;# must update string rep
} {3.14159 31.4159 31.4159}
-test obj-21.1 {Tcl_NewIntObj} {
+test obj-21.1 {Tcl_NewIntObj} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 55]
@@ -385,7 +382,7 @@ test obj-21.1 {Tcl_NewIntObj} {
lappend result [testobj refcount 1]
} {{} 55 int 2}
-test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
+test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -393,7 +390,7 @@ test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 77 int 2}
-test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
+test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 12.34]
@@ -402,94 +399,94 @@ test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}
-test obj-23.1 {Tcl_GetIntFromObj, existing int object} {
+test obj-23.1 {Tcl_GetIntFromObj, existing int object} testobj {
set result ""
lappend result [testintobj set 1 22]
lappend result [testintobj mult10 1] ;# gets existing int rep
} {22 220}
-test obj-23.2 {Tcl_GetIntFromObj, convert to int} {
+test obj-23.2 {Tcl_GetIntFromObj, convert to int} testobj {
set result ""
lappend result [testintobj set 1 477]
lappend result [testintobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47 int}
-test obj-23.3 {Tcl_GetIntFromObj, error converting to int} {
+test obj-23.3 {Tcl_GetIntFromObj, error converting to int} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
+test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testintobj div10 1} msg]
lappend result $msg
} {{} 1 {expected integer but got ""}}
-test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
+test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {testobj nonPortable} {
set result ""
lappend result [testobj newobj 1]
lappend result [testintobj inttoobigtest 1]
} {{} 1}
-test obj-24.1 {DupIntInternalRep} {
+test obj-24.1 {DupIntInternalRep} testobj {
set result ""
lappend result [testintobj set 1 23]
lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep
lappend result [testintobj get 2]
} {23 23 23}
-test obj-25.1 {SetIntFromAny, int to int special case} {
+test obj-25.1 {SetIntFromAny, int to int special case} testobj {
set result ""
lappend result [testintobj set 1 1234]
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
lappend result [testobj type 1]
} {1234 12340 int}
-test obj-25.2 {SetIntFromAny, boolean to int special case} {
+test obj-25.2 {SetIntFromAny, boolean to int special case} testobj {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
lappend result [testobj type 1]
} {1 10 int}
-test obj-25.3 {SetIntFromAny, recompute string rep then parse it} {
+test obj-25.3 {SetIntFromAny, recompute string rep then parse it} testobj {
set result ""
lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
lappend result [testobj type 1]
} {456 45 450 int}
-test obj-25.4 {SetIntFromAny, error parsing string} {
+test obj-25.4 {SetIntFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-25.5 {SetIntFromAny, error parsing string} {
+test obj-25.5 {SetIntFromAny, error parsing string} testobj {
set result ""
lappend result [teststringobj set 1 x17]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {x17 1 {expected integer but got "x17"}}
-test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} {
+test obj-25.6 {SetIntFromAny, integer too large} {testobj nonPortable} {
set result ""
lappend result [teststringobj set 1 123456789012345678901]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {123456789012345678901 1 {integer value too large to represent}}
-test obj-25.7 {SetIntFromAny, error converting from "empty string"} {
+test obj-25.7 {SetIntFromAny, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testintobj div10 1} msg]
lappend result $msg
} {{} 1 {expected integer but got ""}}
-test obj-26.1 {UpdateStringOfInt} {
+test obj-26.1 {UpdateStringOfInt} testobj {
set result ""
lappend result [testintobj set 1 512]
lappend result [testintobj mult10 1]
lappend result [testintobj get 1] ;# must update string rep
} {512 5120 5120}
-test obj-27.1 {Tcl_NewLongObj} {
+test obj-27.1 {Tcl_NewLongObj} testobj {
set result ""
lappend result [testobj freeallvars]
testintobj setmaxlong 1
@@ -498,7 +495,7 @@ test obj-27.1 {Tcl_NewLongObj} {
lappend result [testobj refcount 1]
} {{} 1 int 1}
-test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
+test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -506,7 +503,7 @@ test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 77 int 2}
-test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
+test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 12.34]
@@ -515,31 +512,31 @@ test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}
-test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} {
+test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj {
set result ""
lappend result [testintobj setlong 1 22]
lappend result [testintobj mult10 1] ;# gets existing long int rep
} {22 220}
-test obj-29.2 {Tcl_GetLongFromObj, convert to long} {
+test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj {
set result ""
lappend result [testintobj setlong 1 477]
lappend result [testintobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47 int}
-test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} {
+test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
+test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
lappend result $msg
} {{} 1 {expected integer but got ""}}
-test obj-30.1 {Ref counting and object deletion, simple types} {
+test obj-30.1 {Ref counting and object deletion, simple types} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 1024]
@@ -554,50 +551,46 @@ test obj-30.1 {Ref counting and object deletion, simple types} {
} {{} 1024 1024 int 4 4 0 boolean 3 2}
-test obj-31.1 {regenerate string rep of "end"} {
+test obj-31.1 {regenerate string rep of "end"} testobj {
testobj freeallvars
teststringobj set 1 end
testobj convert 1 end-offset
testobj invalidateStringRep 1
} end
-
-test obj-31.2 {regenerate string rep of "end-1"} {
+test obj-31.2 {regenerate string rep of "end-1"} testobj {
testobj freeallvars
teststringobj set 1 end-0x1
testobj convert 1 end-offset
testobj invalidateStringRep 1
} end-1
-
-test obj-31.3 {regenerate string rep of "end--1"} {
+test obj-31.3 {regenerate string rep of "end--1"} testobj {
testobj freeallvars
teststringobj set 1 end--0x1
testobj convert 1 end-offset
testobj invalidateStringRep 1
} end--1
-
-test obj-31.4 {regenerate string rep of "end-bigInteger"} {
+test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj {
testobj freeallvars
teststringobj set 1 end-0x7fffffff
testobj convert 1 end-offset
testobj invalidateStringRep 1
} end-2147483647
-
-test obj-31.5 {regenerate string rep of "end--bigInteger"} {
+test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj {
testobj freeallvars
teststringobj set 1 end--0x7fffffff
testobj convert 1 end-offset
testobj invalidateStringRep 1
} end--2147483647
-
-
-test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} {
+test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj nonPortable} {
testobj freeallvars
teststringobj set 1 end--0x80000000
testobj convert 1 end-offset
testobj invalidateStringRep 1
} end--2147483648
-testobj freeallvars
+if {[testConstraint testobj]} {
+ testobj freeallvars
+}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index b5db5e5..e65c646 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: parseExpr.test,v 1.11 2003/10/06 14:32:22 dgp Exp $
+# RCS: @(#) $Id: parseExpr.test,v 1.12 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -20,624 +20,619 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# for example, that a math function actually exists, or that the operands
# of "<<" are integers.
-if {[info commands testexprparser] == {}} {
- puts "This application hasn't been compiled with the \"testexprparser\""
- puts "command, so I can't test the Tcl expression parser."
- ::tcltest::cleanupTests
- return
-}
+testConstraint testexprparser [llength [info commands testexprparser]]
# Some tests only work if wide integers (>32bit) are not found to be
# integers at all.
-set ::tcltest::testConstraints(wideIntegerUnparsed) \
- [expr {-1 == 0xffffffff}]
-test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {
+testConstraint wideIntegerUnparsed [expr {-1 == 0xffffffff}]
+
+######################################################################
+
+test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} testexprparser {
testexprparser [bytestring "1+2\0 +3"] -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} {
+test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser {
testexprparser "1 + 2" -1
} {- {} 0 subexpr {1 + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {wideIntegerUnparsed} {
+test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-1.4 {Tcl_ParseExpr procedure, error in conditional expression} {
+test parseExpr-1.4 {Tcl_ParseExpr procedure, error in conditional expression} testexprparser {
list [catch {testexprparser {foo+} -1} msg] $msg
} {1 {syntax error in expression "foo+": variable references require preceding $}}
-test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} {
+test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} testexprparser {
list [catch {testexprparser {1+2 345} -1} msg] $msg
} {1 {syntax error in expression "1+2 345": extra tokens at end of expression}}
-test parseExpr-2.1 {ParseCondExpr procedure, valid test subexpr} {
+test parseExpr-2.1 {ParseCondExpr procedure, valid test subexpr} testexprparser {
testexprparser {2>3? 1 : 0} -1
} {- {} 0 subexpr {2>3? 1 : 0} 11 operator ? 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-2.2 {ParseCondExpr procedure, error in test subexpr} {
+test parseExpr-2.2 {ParseCondExpr procedure, error in test subexpr} testexprparser {
list [catch {testexprparser {0 || foo} -1} msg] $msg
} {1 {syntax error in expression "0 || foo": variable references require preceding $}}
-test parseExpr-2.3 {ParseCondExpr procedure, next lexeme isn't "?"} {
+test parseExpr-2.3 {ParseCondExpr procedure, next lexeme isn't "?"} testexprparser {
testexprparser {1+2} -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-2.4 {ParseCondExpr procedure, next lexeme is "?"} {
+test parseExpr-2.4 {ParseCondExpr procedure, next lexeme is "?"} testexprparser {
testexprparser {1+2 ? 3 : 4} -1
} {- {} 0 subexpr {1+2 ? 3 : 4} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} {wideIntegerUnparsed} {
+test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1+2 ? 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} {
+test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} testexprparser {
testexprparser {1? 3 : 4} -1
} {- {} 0 subexpr {1? 3 : 4} 7 operator ? 0 subexpr 1 1 text 1 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-2.7 {ParseCondExpr procedure, error in "then" subexpression} {
+test parseExpr-2.7 {ParseCondExpr procedure, error in "then" subexpression} testexprparser {
list [catch {testexprparser {1? fred : martha} -1} msg] $msg
} {1 {syntax error in expression "1? fred : martha": variable references require preceding $}}
-test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} {
+test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} testexprparser {
list [catch {testexprparser {1? 2 martha 3} -1} msg] $msg
} {1 {syntax error in expression "1? 2 martha 3": missing colon from ternary conditional}}
-test parseExpr-2.9 {ParseCondExpr procedure, valid "else" subexpression} {
+test parseExpr-2.9 {ParseCondExpr procedure, valid "else" subexpression} testexprparser {
testexprparser {27||3? 3 : 4&&9} -1
} {- {} 0 subexpr {27||3? 3 : 4&&9} 15 operator ? 0 subexpr 27||3 5 operator || 0 subexpr 27 1 text 27 0 subexpr 3 1 text 3 0 subexpr 3 1 text 3 0 subexpr 4&&9 5 operator && 0 subexpr 4 1 text 4 0 subexpr 9 1 text 9 0 {}}
-test parseExpr-2.10 {ParseCondExpr procedure, error in "else" subexpression} {
+test parseExpr-2.10 {ParseCondExpr procedure, error in "else" subexpression} testexprparser {
list [catch {testexprparser {1? 2 : martha} -1} msg] $msg
} {1 {syntax error in expression "1? 2 : martha": variable references require preceding $}}
-test parseExpr-3.1 {ParseLorExpr procedure, valid logical and subexpr} {
+test parseExpr-3.1 {ParseLorExpr procedure, valid logical and subexpr} testexprparser {
testexprparser {1&&2 || 3} -1
} {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-3.2 {ParseLorExpr procedure, error in logical and subexpr} {
+test parseExpr-3.2 {ParseLorExpr procedure, error in logical and subexpr} testexprparser {
list [catch {testexprparser {1&&foo || 3} -1} msg] $msg
} {1 {syntax error in expression "1&&foo || 3": variable references require preceding $}}
-test parseExpr-3.3 {ParseLorExpr procedure, next lexeme isn't "||"} {
+test parseExpr-3.3 {ParseLorExpr procedure, next lexeme isn't "||"} testexprparser {
testexprparser {1&&2? 1 : 0} -1
} {- {} 0 subexpr {1&&2? 1 : 0} 11 operator ? 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-3.4 {ParseLorExpr procedure, next lexeme is "||"} {
+test parseExpr-3.4 {ParseLorExpr procedure, next lexeme is "||"} testexprparser {
testexprparser {1&&2 || 3} -1
} {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} {wideIntegerUnparsed} {
+test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1&&2 || 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} {
+test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1&&2 || 3 || 4} -1
} {- {} 0 subexpr {1&&2 || 3 || 4} 13 operator || 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-3.7 {ParseLorExpr procedure, error in RHS subexpression} {
+test parseExpr-3.7 {ParseLorExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1&&2 || 3 || martha} -1} msg] $msg
} {1 {syntax error in expression "1&&2 || 3 || martha": variable references require preceding $}}
-test parseExpr-4.1 {ParseLandExpr procedure, valid LHS "|" subexpr} {
+test parseExpr-4.1 {ParseLandExpr procedure, valid LHS "|" subexpr} testexprparser {
testexprparser {1|2 && 3} -1
} {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-4.2 {ParseLandExpr procedure, error in LHS "|" subexpr} {
+test parseExpr-4.2 {ParseLandExpr procedure, error in LHS "|" subexpr} testexprparser {
list [catch {testexprparser {1&&foo && 3} -1} msg] $msg
} {1 {syntax error in expression "1&&foo && 3": variable references require preceding $}}
-test parseExpr-4.3 {ParseLandExpr procedure, next lexeme isn't "&&"} {
+test parseExpr-4.3 {ParseLandExpr procedure, next lexeme isn't "&&"} testexprparser {
testexprparser {1|2? 1 : 0} -1
} {- {} 0 subexpr {1|2? 1 : 0} 11 operator ? 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-4.4 {ParseLandExpr procedure, next lexeme is "&&"} {
+test parseExpr-4.4 {ParseLandExpr procedure, next lexeme is "&&"} testexprparser {
testexprparser {1|2 && 3} -1
} {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} {wideIntegerUnparsed} {
+test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1|2 && 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} {
+test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1|2 && 3 && 4} -1
} {- {} 0 subexpr {1|2 && 3 && 4} 13 operator && 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-4.7 {ParseLandExpr procedure, error in RHS subexpression} {
+test parseExpr-4.7 {ParseLandExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1|2 && 3 && martha} -1} msg] $msg
} {1 {syntax error in expression "1|2 && 3 && martha": variable references require preceding $}}
-test parseExpr-5.1 {ParseBitOrExpr procedure, valid LHS "^" subexpr} {
+test parseExpr-5.1 {ParseBitOrExpr procedure, valid LHS "^" subexpr} testexprparser {
testexprparser {1^2 | 3} -1
} {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-5.2 {ParseBitOrExpr procedure, error in LHS "^" subexpr} {
+test parseExpr-5.2 {ParseBitOrExpr procedure, error in LHS "^" subexpr} testexprparser {
list [catch {testexprparser {1|foo | 3} -1} msg] $msg
} {1 {syntax error in expression "1|foo | 3": variable references require preceding $}}
-test parseExpr-5.3 {ParseBitOrExpr procedure, next lexeme isn't "|"} {
+test parseExpr-5.3 {ParseBitOrExpr procedure, next lexeme isn't "|"} testexprparser {
testexprparser {1^2? 1 : 0} -1
} {- {} 0 subexpr {1^2? 1 : 0} 11 operator ? 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-5.4 {ParseBitOrExpr procedure, next lexeme is "|"} {
+test parseExpr-5.4 {ParseBitOrExpr procedure, next lexeme is "|"} testexprparser {
testexprparser {1^2 | 3} -1
} {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} {wideIntegerUnparsed} {
+test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1^2 | 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} {
+test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1^2 | 3 | 4} -1
} {- {} 0 subexpr {1^2 | 3 | 4} 13 operator | 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-5.7 {ParseBitOrExpr procedure, error in RHS subexpression} {
+test parseExpr-5.7 {ParseBitOrExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1^2 | 3 | martha} -1} msg] $msg
} {1 {syntax error in expression "1^2 | 3 | martha": variable references require preceding $}}
-test parseExpr-6.1 {ParseBitXorExpr procedure, valid LHS "&" subexpr} {
+test parseExpr-6.1 {ParseBitXorExpr procedure, valid LHS "&" subexpr} testexprparser {
testexprparser {1&2 ^ 3} -1
} {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-6.2 {ParseBitXorExpr procedure, error in LHS "&" subexpr} {
+test parseExpr-6.2 {ParseBitXorExpr procedure, error in LHS "&" subexpr} testexprparser {
list [catch {testexprparser {1^foo ^ 3} -1} msg] $msg
} {1 {syntax error in expression "1^foo ^ 3": variable references require preceding $}}
-test parseExpr-6.3 {ParseBitXorExpr procedure, next lexeme isn't "^"} {
+test parseExpr-6.3 {ParseBitXorExpr procedure, next lexeme isn't "^"} testexprparser {
testexprparser {1&2? 1 : 0} -1
} {- {} 0 subexpr {1&2? 1 : 0} 11 operator ? 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-6.4 {ParseBitXorExpr procedure, next lexeme is "^"} {
+test parseExpr-6.4 {ParseBitXorExpr procedure, next lexeme is "^"} testexprparser {
testexprparser {1&2 ^ 3} -1
} {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} {wideIntegerUnparsed} {
+test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1&2 ^ 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} {
+test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1&2 ^ 3 ^ 4} -1
} {- {} 0 subexpr {1&2 ^ 3 ^ 4} 13 operator ^ 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-6.7 {ParseBitXorExpr procedure, error in RHS subexpression} {
+test parseExpr-6.7 {ParseBitXorExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1&2 ^ 3 ^ martha} -1} msg] $msg
} {1 {syntax error in expression "1&2 ^ 3 ^ martha": variable references require preceding $}}
-test parseExpr-7.1 {ParseBitAndExpr procedure, valid LHS equality subexpr} {
+test parseExpr-7.1 {ParseBitAndExpr procedure, valid LHS equality subexpr} testexprparser {
testexprparser {1==2 & 3} -1
} {- {} 0 subexpr {1==2 & 3} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.2 {ParseBitAndExpr procedure, error in LHS equality subexpr} {
+test parseExpr-7.2 {ParseBitAndExpr procedure, error in LHS equality subexpr} testexprparser {
list [catch {testexprparser {1!=foo & 3} -1} msg] $msg
} {1 {syntax error in expression "1!=foo & 3": variable references require preceding $}}
-test parseExpr-7.3 {ParseBitAndExpr procedure, next lexeme isn't "&"} {
+test parseExpr-7.3 {ParseBitAndExpr procedure, next lexeme isn't "&"} testexprparser {
testexprparser {1==2? 1 : 0} -1
} {- {} 0 subexpr {1==2? 1 : 0} 11 operator ? 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-7.4 {ParseBitAndExpr procedure, next lexeme is "&"} {
+test parseExpr-7.4 {ParseBitAndExpr procedure, next lexeme is "&"} testexprparser {
testexprparser {1>2 & 3} -1
} {- {} 0 subexpr {1>2 & 3} 9 operator & 0 subexpr 1>2 5 operator > 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {wideIntegerUnparsed} {
+test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1==2 & 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} {
+test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1<2 & 3 & 4} -1
} {- {} 0 subexpr {1<2 & 3 & 4} 13 operator & 0 subexpr {1<2 & 3} 9 operator & 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-7.7 {ParseBitAndExpr procedure, error in RHS subexpression} {
+test parseExpr-7.7 {ParseBitAndExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1==2 & 3>2 & martha} -1} msg] $msg
} {1 {syntax error in expression "1==2 & 3>2 & martha": variable references require preceding $}}
-test parseExpr-8.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} {
+test parseExpr-8.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} testexprparser {
testexprparser {1<2 == 3} -1
} {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} {
+test parseExpr-8.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} testexprparser {
list [catch {testexprparser {1>=foo == 3} -1} msg] $msg
} {1 {syntax error in expression "1>=foo == 3": variable references require preceding $}}
-test parseExpr-8.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} {
+test parseExpr-8.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} testexprparser {
testexprparser {1<2? 1 : 0} -1
} {- {} 0 subexpr {1<2? 1 : 0} 11 operator ? 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-8.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} {
+test parseExpr-8.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} testexprparser {
testexprparser {1<2 == 3} -1
} {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} {
+test parseExpr-8.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} testexprparser {
testexprparser {1<2 != 3} -1
} {- {} 0 subexpr {1<2 != 3} 9 operator != 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} {wideIntegerUnparsed} {
+test parseExpr-8.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1<2 == 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-8.7 {ParseEqualityExpr procedure, valid RHS subexpression} {
+test parseExpr-8.7 {ParseEqualityExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1<2 == 3 == 4} -1
} {- {} 0 subexpr {1<2 == 3 == 4} 13 operator == 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-8.8 {ParseEqualityExpr procedure, error in RHS subexpression} {
+test parseExpr-8.8 {ParseEqualityExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1<2 == 3 != martha} -1} msg] $msg
} {1 {syntax error in expression "1<2 == 3 != martha": variable references require preceding $}}
-test parseExpr-9.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} {
+test parseExpr-9.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} testexprparser {
testexprparser {1<<2 < 3} -1
} {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} {
+test parseExpr-9.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} testexprparser {
list [catch {testexprparser {1>=foo < 3} -1} msg] $msg
} {1 {syntax error in expression "1>=foo < 3": variable references require preceding $}}
-test parseExpr-9.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} {
+test parseExpr-9.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} testexprparser {
testexprparser {1<<2? 1 : 0} -1
} {- {} 0 subexpr {1<<2? 1 : 0} 11 operator ? 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-9.4 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.4 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser {
testexprparser {1<<2 < 3} -1
} {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.5 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.5 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser {
testexprparser {1>>2 > 3} -1
} {- {} 0 subexpr {1>>2 > 3} 9 operator > 0 subexpr 1>>2 5 operator >> 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.6 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.6 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser {
testexprparser {1<<2 <= 3} -1
} {- {} 0 subexpr {1<<2 <= 3} 9 operator <= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.7 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.7 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser {
testexprparser {1<<2 >= 3} -1
} {- {} 0 subexpr {1<<2 >= 3} 9 operator >= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.8 {ParseRelationalExpr procedure, bad lexeme after relational op} {wideIntegerUnparsed} {
+test parseExpr-9.8 {ParseRelationalExpr procedure, bad lexeme after relational op} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1<<2 < 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-9.9 {ParseRelationalExpr procedure, valid RHS subexpression} {
+test parseExpr-9.9 {ParseRelationalExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1<<2 < 3 < 4} -1
} {- {} 0 subexpr {1<<2 < 3 < 4} 13 operator < 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-9.10 {ParseRelationalExpr procedure, error in RHS subexpression} {
+test parseExpr-9.10 {ParseRelationalExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1<<2 < 3 > martha} -1} msg] $msg
} {1 {syntax error in expression "1<<2 < 3 > martha": variable references require preceding $}}
-test parseExpr-10.1 {ParseShiftExpr procedure, valid LHS add subexpr} {
+test parseExpr-10.1 {ParseShiftExpr procedure, valid LHS add subexpr} testexprparser {
testexprparser {1+2 << 3} -1
} {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.2 {ParseShiftExpr procedure, error in LHS add subexpr} {
+test parseExpr-10.2 {ParseShiftExpr procedure, error in LHS add subexpr} testexprparser {
list [catch {testexprparser {1-foo << 3} -1} msg] $msg
} {1 {syntax error in expression "1-foo << 3": variable references require preceding $}}
-test parseExpr-10.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} {
+test parseExpr-10.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} testexprparser {
testexprparser {1+2? 1 : 0} -1
} {- {} 0 subexpr {1+2? 1 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-10.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} {
+test parseExpr-10.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} testexprparser {
testexprparser {1+2 << 3} -1
} {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} {
+test parseExpr-10.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} testexprparser {
testexprparser {1+2 >> 3} -1
} {- {} 0 subexpr {1+2 >> 3} 9 operator >> 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} {wideIntegerUnparsed} {
+test parseExpr-10.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1+2 << 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-10.7 {ParseShiftExpr procedure, valid RHS subexpression} {
+test parseExpr-10.7 {ParseShiftExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1+2 << 3 << 4} -1
} {- {} 0 subexpr {1+2 << 3 << 4} 13 operator << 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-10.8 {ParseShiftExpr procedure, error in RHS subexpression} {
+test parseExpr-10.8 {ParseShiftExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1+2 << 3 >> martha} -1} msg] $msg
} {1 {syntax error in expression "1+2 << 3 >> martha": variable references require preceding $}}
-test parseExpr-11.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
+test parseExpr-11.1 {ParseAddExpr procedure, valid LHS multiply subexpr} testexprparser {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
+test parseExpr-11.2 {ParseAddExpr procedure, error in LHS multiply subexpr} testexprparser {
list [catch {testexprparser {1/foo + 3} -1} msg] $msg
} {1 {syntax error in expression "1/foo + 3": variable references require preceding $}}
-test parseExpr-11.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
+test parseExpr-11.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} testexprparser {
testexprparser {1*2? 1 : 0} -1
} {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-11.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+test parseExpr-11.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+test parseExpr-11.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser {
testexprparser {1*2 - 3} -1
} {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {wideIntegerUnparsed} {
+test parseExpr-11.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-11.7 {ParseAddExpr procedure, valid RHS subexpression} {
+test parseExpr-11.7 {ParseAddExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1*2 + 3 + 4} -1
} {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-11.8 {ParseAddExpr procedure, error in RHS subexpression} {
+test parseExpr-11.8 {ParseAddExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
} {1 {syntax error in expression "1*2 + 3 - martha": variable references require preceding $}}
-test parseExpr-12.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
+test parseExpr-12.1 {ParseAddExpr procedure, valid LHS multiply subexpr} testexprparser {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-12.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
+test parseExpr-12.2 {ParseAddExpr procedure, error in LHS multiply subexpr} testexprparser {
list [catch {testexprparser {1/foo + 3} -1} msg] $msg
} {1 {syntax error in expression "1/foo + 3": variable references require preceding $}}
-test parseExpr-12.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
+test parseExpr-12.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} testexprparser {
testexprparser {1*2? 1 : 0} -1
} {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-12.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+test parseExpr-12.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-12.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+test parseExpr-12.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser {
testexprparser {1*2 - 3} -1
} {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-12.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {wideIntegerUnparsed} {
+test parseExpr-12.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-12.7 {ParseAddExpr procedure, valid RHS subexpression} {
+test parseExpr-12.7 {ParseAddExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {1*2 + 3 + 4} -1
} {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-12.8 {ParseAddExpr procedure, error in RHS subexpression} {
+test parseExpr-12.8 {ParseAddExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
} {1 {syntax error in expression "1*2 + 3 - martha": variable references require preceding $}}
-test parseExpr-13.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} {
+test parseExpr-13.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} testexprparser {
testexprparser {+2 * 3} -1
} {- {} 0 subexpr {+2 * 3} 7 operator * 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-13.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} {wideIntegerUnparsed} {
+test parseExpr-13.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {-12345678901234567890 * 3} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} {
+test parseExpr-13.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} testexprparser {
testexprparser {+2? 1 : 0} -1
} {- {} 0 subexpr {+2? 1 : 0} 9 operator ? 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-13.4 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+test parseExpr-13.4 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser {
testexprparser {-123 * 3} -1
} {- {} 0 subexpr {-123 * 3} 7 operator * 0 subexpr -123 3 operator - 0 subexpr 123 1 text 123 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-13.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+test parseExpr-13.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser {
testexprparser {+-456 / 3} -1
} {- {} 0 subexpr {+-456 / 3} 9 operator / 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-13.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+test parseExpr-13.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser {
testexprparser {+-456 % 3} -1
} {- {} 0 subexpr {+-456 % 3} 9 operator % 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-13.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} {wideIntegerUnparsed} {
+test parseExpr-13.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {--++5 / 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.8 {ParseMultiplyExpr procedure, valid RHS subexpression} {
+test parseExpr-13.8 {ParseMultiplyExpr procedure, valid RHS subexpression} testexprparser {
testexprparser {-2 / 3 % 4} -1
} {- {} 0 subexpr {-2 / 3 % 4} 11 operator % 0 subexpr {-2 / 3} 7 operator / 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-13.9 {ParseMultiplyExpr procedure, error in RHS subexpression} {
+test parseExpr-13.9 {ParseMultiplyExpr procedure, error in RHS subexpression} testexprparser {
list [catch {testexprparser {++2 / 3 * martha} -1} msg] $msg
} {1 {syntax error in expression "++2 / 3 * martha": variable references require preceding $}}
-test parseExpr-14.1 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.1 {ParseUnaryExpr procedure, first token is unary operator} testexprparser {
testexprparser {+2} -1
} {- {} 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.2 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.2 {ParseUnaryExpr procedure, first token is unary operator} testexprparser {
testexprparser {-2} -1
} {- {} 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.3 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.3 {ParseUnaryExpr procedure, first token is unary operator} testexprparser {
testexprparser {~2} -1
} {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.4 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.4 {ParseUnaryExpr procedure, first token is unary operator} testexprparser {
testexprparser {!2} -1
} {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.5 {ParseUnaryExpr procedure, error in lexeme after unary op} {wideIntegerUnparsed} {
+test parseExpr-14.5 {ParseUnaryExpr procedure, error in lexeme after unary op} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {-12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-14.6 {ParseUnaryExpr procedure, simple unary expr after unary op} {
+test parseExpr-14.6 {ParseUnaryExpr procedure, simple unary expr after unary op} testexprparser {
testexprparser {+"1234"} -1
} {- {} 0 subexpr +\"1234\" 3 operator + 0 subexpr {"1234"} 1 text 1234 0 {}}
-test parseExpr-14.7 {ParseUnaryExpr procedure, another unary expr after unary op} {
+test parseExpr-14.7 {ParseUnaryExpr procedure, another unary expr after unary op} testexprparser {
testexprparser {~!{fred}} -1
} {- {} 0 subexpr ~!{fred} 5 operator ~ 0 subexpr !{fred} 3 operator ! 0 subexpr {{fred}} 1 text fred 0 {}}
-test parseExpr-14.8 {ParseUnaryExpr procedure, error in unary expr after unary op} {
+test parseExpr-14.8 {ParseUnaryExpr procedure, error in unary expr after unary op} testexprparser {
list [catch {testexprparser {+-||27} -1} msg] $msg
} {1 {syntax error in expression "+-||27": unexpected operator ||}}
-test parseExpr-14.9 {ParseUnaryExpr procedure, error in unary expr after unary op} {
+test parseExpr-14.9 {ParseUnaryExpr procedure, error in unary expr after unary op} testexprparser {
list [catch {testexprparser {+-||27} -1} msg] $msg
} {1 {syntax error in expression "+-||27": unexpected operator ||}}
-test parseExpr-14.10 {ParseUnaryExpr procedure, first token is not unary op} {
+test parseExpr-14.10 {ParseUnaryExpr procedure, first token is not unary op} testexprparser {
testexprparser {123} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-14.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} {
+test parseExpr-14.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} testexprparser {
testexprparser {(1+2)} -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} {wideIntegerUnparsed} {
+test parseExpr-14.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-15.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} {
+test parseExpr-15.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} testexprparser {
testexprparser {({abc}/{def})} -1
} {- {} 0 subexpr {{abc}/{def}} 5 operator / 0 subexpr {{abc}} 1 text abc 0 subexpr {{def}} 1 text def 0 {}}
-test parseExpr-15.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {wideIntegerUnparsed} {
+test parseExpr-15.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-15.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} {
+test parseExpr-15.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} testexprparser {
testexprparser {({abc}? 2*4 : -6)} -1
} {- {} 0 subexpr {{abc}? 2*4 : -6} 13 operator ? 0 subexpr {{abc}} 1 text abc 0 subexpr 2*4 5 operator * 0 subexpr 2 1 text 2 0 subexpr 4 1 text 4 0 subexpr -6 3 operator - 0 subexpr 6 1 text 6 0 {}}
-test parseExpr-15.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} {
+test parseExpr-15.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} testexprparser {
list [catch {testexprparser {(? 123 : 456)} -1} msg] $msg
} {1 {syntax error in expression "(? 123 : 456)": unexpected ternary 'then' separator}}
-test parseExpr-15.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} {
+test parseExpr-15.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} testexprparser {
list [catch {testexprparser {({abc}/{def}} -1} msg] $msg
} {1 {syntax error in expression "({abc}/{def}": looking for close parenthesis}}
-test parseExpr-15.6 {ParsePrimaryExpr procedure, primary is literal} {
+test parseExpr-15.6 {ParsePrimaryExpr procedure, primary is literal} testexprparser {
testexprparser {12345} -1
} {- {} 0 subexpr 12345 1 text 12345 0 {}}
-test parseExpr-15.7 {ParsePrimaryExpr procedure, primary is literal} {
+test parseExpr-15.7 {ParsePrimaryExpr procedure, primary is literal} testexprparser {
testexprparser {12345.6789} -1
} {- {} 0 subexpr 12345.6789 1 text 12345.6789 0 {}}
-test parseExpr-15.8 {ParsePrimaryExpr procedure, primary is var reference} {
+test parseExpr-15.8 {ParsePrimaryExpr procedure, primary is var reference} testexprparser {
testexprparser {$a} -1
} {- {} 0 subexpr {$a} 2 variable {$a} 1 text a 0 {}}
-test parseExpr-15.9 {ParsePrimaryExpr procedure, primary is var reference} {
+test parseExpr-15.9 {ParsePrimaryExpr procedure, primary is var reference} testexprparser {
testexprparser {$a(hello$there)} -1
} {- {} 0 subexpr {$a(hello$there)} 5 variable {$a(hello$there)} 4 text a 0 text hello 0 variable {$there} 1 text there 0 {}}
-test parseExpr-15.10 {ParsePrimaryExpr procedure, primary is var reference} {
+test parseExpr-15.10 {ParsePrimaryExpr procedure, primary is var reference} testexprparser {
testexprparser {$a()} -1
} {- {} 0 subexpr {$a()} 3 variable {$a()} 2 text a 0 text {} 0 {}}
-test parseExpr-15.11 {ParsePrimaryExpr procedure, error in var reference} {
+test parseExpr-15.11 {ParsePrimaryExpr procedure, error in var reference} testexprparser {
list [catch {testexprparser {$a(} -1} msg] $msg
} {1 {missing )}}
-test parseExpr-15.12 {ParsePrimaryExpr procedure, primary is quoted string} {
+test parseExpr-15.12 {ParsePrimaryExpr procedure, primary is quoted string} testexprparser {
testexprparser {"abc $xyz def"} -1
} {- {} 0 subexpr {"abc $xyz def"} 5 word {"abc $xyz def"} 4 text {abc } 0 variable {$xyz} 1 text xyz 0 text { def} 0 {}}
-test parseExpr-15.13 {ParsePrimaryExpr procedure, error in quoted string} {
+test parseExpr-15.13 {ParsePrimaryExpr procedure, error in quoted string} testexprparser {
list [catch {testexprparser {"$a(12"} -1} msg] $msg
} {1 {missing )}}
-test parseExpr-15.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} {
+test parseExpr-15.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} testexprparser {
testexprparser {"abc [xyz] $def"} -1
} {- {} 0 subexpr {"abc [xyz] $def"} 6 word {"abc [xyz] $def"} 5 text {abc } 0 command {[xyz]} 0 text { } 0 variable {$def} 1 text def 0 {}}
-test parseExpr-15.15 {ParsePrimaryExpr procedure, primary is command} {
+test parseExpr-15.15 {ParsePrimaryExpr procedure, primary is command} testexprparser {
testexprparser {[def]} -1
} {- {} 0 subexpr {[def]} 1 command {[def]} 0 {}}
-test parseExpr-15.16 {ParsePrimaryExpr procedure, primary is multiple commands} {
+test parseExpr-15.16 {ParsePrimaryExpr procedure, primary is multiple commands} testexprparser {
testexprparser {[one; two; three; four;]} -1
} {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
-test parseExpr-15.17 {ParsePrimaryExpr procedure, primary is multiple commands} {
+test parseExpr-15.17 {ParsePrimaryExpr procedure, primary is multiple commands} testexprparser {
testexprparser {[one; two; three; four;]} -1
} {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
-test parseExpr-15.18 {ParsePrimaryExpr procedure, missing close bracket} {
+test parseExpr-15.18 {ParsePrimaryExpr procedure, missing close bracket} testexprparser {
list [catch {testexprparser {[one} -1} msg] $msg
} {1 {missing close-bracket}}
-test parseExpr-15.19 {ParsePrimaryExpr procedure, primary is braced string} {
+test parseExpr-15.19 {ParsePrimaryExpr procedure, primary is braced string} testexprparser {
testexprparser {{hello world}} -1
} {- {} 0 subexpr {{hello world}} 1 text {hello world} 0 {}}
-test parseExpr-15.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} {
+test parseExpr-15.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} testexprparser {
list [catch {testexprparser "\{abc\\\n" -1} msg] $msg
} {1 {missing close-brace}}
-test parseExpr-15.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} {
+test parseExpr-15.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} testexprparser {
testexprparser "\{ \\
+123 \}" -1
} {- {} 0 subexpr \{\ \ \\\n\ +123\ \} 4 word \{\ \ \\\n\ +123\ \} 3 text { } 0 backslash \\\n\ 0 text {+123 } 0 {}}
-test parseExpr-15.22 {ParsePrimaryExpr procedure, primary is function call} {
+test parseExpr-15.22 {ParsePrimaryExpr procedure, primary is function call} testexprparser {
testexprparser {foo(123)} -1
} {- {} 0 subexpr foo(123) 3 operator foo 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-15.23 {ParsePrimaryExpr procedure, bad lexeme after function name} {wideIntegerUnparsed} {
+test parseExpr-15.23 {ParsePrimaryExpr procedure, bad lexeme after function name} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {foo 12345678901234567890 123)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-15.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} {
+test parseExpr-15.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} testexprparser {
list [catch {testexprparser {foo 27.4 123)} -1} msg] $msg
} {1 {syntax error in expression "foo 27.4 123)": variable references require preceding $}}
-test parseExpr-15.25 {ParsePrimaryExpr procedure, bad lexeme after "("} {wideIntegerUnparsed} {
+test parseExpr-15.25 {ParsePrimaryExpr procedure, bad lexeme after "("} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {foo(12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-15.26 {ParsePrimaryExpr procedure, function call, one arg} {
+test parseExpr-15.26 {ParsePrimaryExpr procedure, function call, one arg} testexprparser {
testexprparser {foo(27*4)} -1
} {- {} 0 subexpr foo(27*4) 7 operator foo 0 subexpr 27*4 5 operator * 0 subexpr 27 1 text 27 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-15.27 {ParsePrimaryExpr procedure, error in function arg} {
+test parseExpr-15.27 {ParsePrimaryExpr procedure, error in function arg} testexprparser {
list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
} {1 {syntax error in expression "foo(*1-2)": unexpected operator *}}
-test parseExpr-15.28 {ParsePrimaryExpr procedure, error in function arg} {
+test parseExpr-15.28 {ParsePrimaryExpr procedure, error in function arg} testexprparser {
list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
} {1 {syntax error in expression "foo(*1-2)": unexpected operator *}}
-test parseExpr-15.29 {ParsePrimaryExpr procedure, function call, comma after arg} {
+test parseExpr-15.29 {ParsePrimaryExpr procedure, function call, comma after arg} testexprparser {
testexprparser {foo(27-2, (-2*[foo]))} -1
} {- {} 0 subexpr {foo(27-2, (-2*[foo]))} 15 operator foo 0 subexpr 27-2 5 operator - 0 subexpr 27 1 text 27 0 subexpr 2 1 text 2 0 subexpr {-2*[foo]} 7 operator * 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
-test parseExpr-15.30 {ParsePrimaryExpr procedure, bad lexeme after comma} {wideIntegerUnparsed} {
+test parseExpr-15.30 {ParsePrimaryExpr procedure, bad lexeme after comma} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {foo(123, 12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-15.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} {
+test parseExpr-15.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} testexprparser {
list [catch {testexprparser {foo(123 [foo])} -1} msg] $msg
} {1 {syntax error in expression "foo(123 [foo])": missing close parenthesis at end of function call}}
-test parseExpr-15.32 {ParsePrimaryExpr procedure, bad lexeme after primary} {wideIntegerUnparsed} {
+test parseExpr-15.32 {ParsePrimaryExpr procedure, bad lexeme after primary} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {123 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-15.33 {ParsePrimaryExpr procedure, comma-specific message} {
+test parseExpr-15.33 {ParsePrimaryExpr procedure, comma-specific message} testexprparser {
list [catch {testexprparser {123+,456} -1} msg] $msg
} {1 {syntax error in expression "123+,456": commas can only separate function arguments}}
-test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} {
+test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} testexprparser {
list [catch {testexprparser {123+=456} -1} msg] $msg
} {1 {syntax error in expression "123+=456": single equality character not legal in expressions}}
-test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} {
+test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} testexprparser {
list [catch {testexprparser {(: 123 : 456)} -1} msg] $msg
} {1 {syntax error in expression "(: 123 : 456)": unexpected ternary 'else' separator}}
-test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} {
+test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} testexprparser {
# Test for Bug 681841
list [catch {testexprparser {[set a [format bc]} -1} msg] $msg
} {1 {missing close-bracket}}
-test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} {
+test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} testexprparser {
testexprparser { 123} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-16.2 {GetLexeme procedure, whitespace before lexeme} {
+test parseExpr-16.2 {GetLexeme procedure, whitespace before lexeme} testexprparser {
testexprparser { \
456} -1
} {- {} 0 subexpr 456 1 text 456 0 {}}
-test parseExpr-16.3 {GetLexeme procedure, no lexeme after whitespace} {
+test parseExpr-16.3 {GetLexeme procedure, no lexeme after whitespace} testexprparser {
testexprparser { 123 \
} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-16.4 {GetLexeme procedure, integer lexeme} {
+test parseExpr-16.4 {GetLexeme procedure, integer lexeme} testexprparser {
testexprparser {000} -1
} {- {} 0 subexpr 000 1 text 000 0 {}}
-test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} {wideIntegerUnparsed} {
+test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} {testexprparser wideIntegerUnparsed} {
list [catch {testexprparser {12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-
-test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -body {
+test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -constraints testexprparser -body {
testexprparser {0999} -1
} -returnCodes error -match glob -result {*invalid octal number*}
-
-test parseExpr-16.7 {GetLexeme procedure, double lexeme} {
+test parseExpr-16.7 {GetLexeme procedure, double lexeme} testexprparser {
testexprparser {0.999} -1
} {- {} 0 subexpr 0.999 1 text 0.999 0 {}}
-test parseExpr-16.8 {GetLexeme procedure, double lexeme} {
+test parseExpr-16.8 {GetLexeme procedure, double lexeme} testexprparser {
testexprparser {.123} -1
} {- {} 0 subexpr .123 1 text .123 0 {}}
-test parseExpr-16.9 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
+test parseExpr-16.9 {GetLexeme procedure, double lexeme} {testexprparser nonPortable unixOnly} {
testexprparser {nan} -1
} {- {} 0 subexpr nan 1 text nan 0 {}}
-test parseExpr-16.10 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
+test parseExpr-16.10 {GetLexeme procedure, double lexeme} {testexprparser nonPortable unixOnly} {
testexprparser {NaN} -1
} {- {} 0 subexpr NaN 1 text NaN 0 {}}
-test parseExpr-16.11 {GetLexeme procedure, bad double lexeme too big} {
+test parseExpr-16.11 {GetLexeme procedure, bad double lexeme too big} testexprparser {
list [catch {testexprparser {123.e+99999999999999} -1} msg] $msg
} {1 {floating-point value too large to represent}}
-test parseExpr-16.12 {GetLexeme procedure, bad double lexeme} {
+test parseExpr-16.12 {GetLexeme procedure, bad double lexeme} testexprparser {
list [catch {testexprparser {123.4x56} -1} msg] $msg
} {1 {syntax error in expression "123.4x56": extra tokens at end of expression}}
-test parseExpr-16.13 {GetLexeme procedure, lexeme is "["} {
+test parseExpr-16.13 {GetLexeme procedure, lexeme is "["} testexprparser {
testexprparser {[foo]} -1
} {- {} 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
-test parseExpr-16.14 {GetLexeme procedure, lexeme is open brace} {
+test parseExpr-16.14 {GetLexeme procedure, lexeme is open brace} testexprparser {
testexprparser {{bar}} -1
} {- {} 0 subexpr {{bar}} 1 text bar 0 {}}
-test parseExpr-16.15 {GetLexeme procedure, lexeme is "("} {
+test parseExpr-16.15 {GetLexeme procedure, lexeme is "("} testexprparser {
testexprparser {(123)} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-16.16 {GetLexeme procedure, lexeme is ")"} {
+test parseExpr-16.16 {GetLexeme procedure, lexeme is ")"} testexprparser {
testexprparser {(2*3)} -1
} {- {} 0 subexpr 2*3 5 operator * 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.17 {GetLexeme procedure, lexeme is "$"} {
+test parseExpr-16.17 {GetLexeme procedure, lexeme is "$"} testexprparser {
testexprparser {$wombat} -1
} {- {} 0 subexpr {$wombat} 2 variable {$wombat} 1 text wombat 0 {}}
-test parseExpr-16.18 "GetLexeme procedure, lexeme is '\"'" {
+test parseExpr-16.18 "GetLexeme procedure, lexeme is '\"'" testexprparser {
testexprparser {"fred"} -1
} {- {} 0 subexpr {"fred"} 1 text fred 0 {}}
-test parseExpr-16.19 {GetLexeme procedure, lexeme is ","} {
+test parseExpr-16.19 {GetLexeme procedure, lexeme is ","} testexprparser {
testexprparser {foo(1,2)} -1
} {- {} 0 subexpr foo(1,2) 5 operator foo 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.20 {GetLexeme procedure, lexeme is "*"} {
+test parseExpr-16.20 {GetLexeme procedure, lexeme is "*"} testexprparser {
testexprparser {$a*$b} -1
} {- {} 0 subexpr {$a*$b} 7 operator * 0 subexpr {$a} 2 variable {$a} 1 text a 0 subexpr {$b} 2 variable {$b} 1 text b 0 {}}
-test parseExpr-16.21 {GetLexeme procedure, lexeme is "/"} {
+test parseExpr-16.21 {GetLexeme procedure, lexeme is "/"} testexprparser {
testexprparser {5/6} -1
} {- {} 0 subexpr 5/6 5 operator / 0 subexpr 5 1 text 5 0 subexpr 6 1 text 6 0 {}}
-test parseExpr-16.22 {GetLexeme procedure, lexeme is "%"} {
+test parseExpr-16.22 {GetLexeme procedure, lexeme is "%"} testexprparser {
testexprparser {5%[xxx]} -1
} {- {} 0 subexpr {5%[xxx]} 5 operator % 0 subexpr 5 1 text 5 0 subexpr {[xxx]} 1 command {[xxx]} 0 {}}
-test parseExpr-16.23 {GetLexeme procedure, lexeme is "+"} {
+test parseExpr-16.23 {GetLexeme procedure, lexeme is "+"} testexprparser {
testexprparser {1+2} -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.24 {GetLexeme procedure, lexeme is "-"} {
+test parseExpr-16.24 {GetLexeme procedure, lexeme is "-"} testexprparser {
testexprparser {.12-0e27} -1
} {- {} 0 subexpr .12-0e27 5 operator - 0 subexpr .12 1 text .12 0 subexpr 0e27 1 text 0e27 0 {}}
-test parseExpr-16.25 {GetLexeme procedure, lexeme is "?" or ":"} {
+test parseExpr-16.25 {GetLexeme procedure, lexeme is "?" or ":"} testexprparser {
testexprparser {$b? 1 : 0} -1
} {- {} 0 subexpr {$b? 1 : 0} 8 operator ? 0 subexpr {$b} 2 variable {$b} 1 text b 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-16.26 {GetLexeme procedure, lexeme is "<"} {
+test parseExpr-16.26 {GetLexeme procedure, lexeme is "<"} testexprparser {
testexprparser {2<3} -1
} {- {} 0 subexpr 2<3 5 operator < 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.27 {GetLexeme procedure, lexeme is "<<"} {
+test parseExpr-16.27 {GetLexeme procedure, lexeme is "<<"} testexprparser {
testexprparser {2<<3} -1
} {- {} 0 subexpr 2<<3 5 operator << 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.28 {GetLexeme procedure, lexeme is "<="} {
+test parseExpr-16.28 {GetLexeme procedure, lexeme is "<="} testexprparser {
testexprparser {2<=3} -1
} {- {} 0 subexpr 2<=3 5 operator <= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.29 {GetLexeme procedure, lexeme is ">"} {
+test parseExpr-16.29 {GetLexeme procedure, lexeme is ">"} testexprparser {
testexprparser {2>3} -1
} {- {} 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.30 {GetLexeme procedure, lexeme is ">>"} {
+test parseExpr-16.30 {GetLexeme procedure, lexeme is ">>"} testexprparser {
testexprparser {2>>3} -1
} {- {} 0 subexpr 2>>3 5 operator >> 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.31 {GetLexeme procedure, lexeme is ">="} {
+test parseExpr-16.31 {GetLexeme procedure, lexeme is ">="} testexprparser {
testexprparser {2>=3} -1
} {- {} 0 subexpr 2>=3 5 operator >= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.32 {GetLexeme procedure, lexeme is "=="} {
+test parseExpr-16.32 {GetLexeme procedure, lexeme is "=="} testexprparser {
testexprparser {2==3} -1
} {- {} 0 subexpr 2==3 5 operator == 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.33 {GetLexeme procedure, bad lexeme starting with "="} {
+test parseExpr-16.33 {GetLexeme procedure, bad lexeme starting with "="} testexprparser {
list [catch {testexprparser {2=+3} -1} msg] $msg
} {1 {syntax error in expression "2=+3": extra tokens at end of expression}}
-test parseExpr-16.34 {GetLexeme procedure, lexeme is "!="} {
+test parseExpr-16.34 {GetLexeme procedure, lexeme is "!="} testexprparser {
testexprparser {2!=3} -1
} {- {} 0 subexpr 2!=3 5 operator != 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.35 {GetLexeme procedure, lexeme is "!"} {
+test parseExpr-16.35 {GetLexeme procedure, lexeme is "!"} testexprparser {
testexprparser {!2} -1
} {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.36 {GetLexeme procedure, lexeme is "&&"} {
+test parseExpr-16.36 {GetLexeme procedure, lexeme is "&&"} testexprparser {
testexprparser {2&&3} -1
} {- {} 0 subexpr 2&&3 5 operator && 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.37 {GetLexeme procedure, lexeme is "&"} {
+test parseExpr-16.37 {GetLexeme procedure, lexeme is "&"} testexprparser {
testexprparser {1&2} -1
} {- {} 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.38 {GetLexeme procedure, lexeme is "^"} {
+test parseExpr-16.38 {GetLexeme procedure, lexeme is "^"} testexprparser {
testexprparser {1^2} -1
} {- {} 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.39 {GetLexeme procedure, lexeme is "||"} {
+test parseExpr-16.39 {GetLexeme procedure, lexeme is "||"} testexprparser {
testexprparser {2||3} -1
} {- {} 0 subexpr 2||3 5 operator || 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.40 {GetLexeme procedure, lexeme is "|"} {
+test parseExpr-16.40 {GetLexeme procedure, lexeme is "|"} testexprparser {
testexprparser {1|2} -1
} {- {} 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.41 {GetLexeme procedure, lexeme is "~"} {
+test parseExpr-16.41 {GetLexeme procedure, lexeme is "~"} testexprparser {
testexprparser {~2} -1
} {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-16.42 {GetLexeme procedure, lexeme is func name} {
+test parseExpr-16.42 {GetLexeme procedure, lexeme is func name} testexprparser {
testexprparser {george()} -1
} {- {} 0 subexpr george() 1 operator george 0 {}}
-test parseExpr-16.43 {GetLexeme procedure, lexeme is func name} {
+test parseExpr-16.43 {GetLexeme procedure, lexeme is func name} testexprparser {
testexprparser {harmonic_ratio(2,3)} -1
} {- {} 0 subexpr harmonic_ratio(2,3) 5 operator harmonic_ratio 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.44 {GetLexeme procedure, unknown lexeme} {
+test parseExpr-16.44 {GetLexeme procedure, unknown lexeme} testexprparser {
list [catch {testexprparser {@27} -1} msg] $msg
} {1 {syntax error in expression "@27": character not legal in expressions}}
-test parseExpr-17.1 {PrependSubExprTokens procedure, expand token array} {
+test parseExpr-17.1 {PrependSubExprTokens procedure, expand token array} testexprparser {
testexprparser {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} -1
} {- {} 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 13 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 9 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 5 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 {}}
-test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
+test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} testexprparser {
list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg
} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012...": premature end of expression}}
diff --git a/tests/rename.test b/tests/rename.test
index a33afaa..45d6847 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -11,13 +11,15 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: rename.test,v 1.11 2004/03/30 16:22:22 msofer Exp $
+# RCS: @(#) $Id: rename.test,v 1.12 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+testConstraint testdel [llength [info commands testdel]]
+
# Must eliminate the "unknown" command while the test is running,
# especially if the test is being run in a program with its
# own special-purpose unknown command.
@@ -77,65 +79,63 @@ catch {rename unknown {}}
catch {rename unknown.old unknown}
catch {rename bar {}}
-if {[info command testdel] == "testdel"} {
- test rename-4.1 {reentrancy issues with command deletion and renaming} {
- set x {}
- testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]}
- rename foo bar
- lappend x |
- rename bar {}
- set x
- } {| deleted {}}
- test rename-4.2 {reentrancy issues with command deletion and renaming} {
- set x {}
- testdel {} foo {lappend x deleted; rename foo bar}
- rename foo {}
- set x
- } {deleted}
- test rename-4.3 {reentrancy issues with command deletion and renaming} {
- set x {}
- testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}}
- rename foo {}
- lappend x |
- rename foo {}
- set x
- } {deleted | deleted2}
- test rename-4.4 {reentrancy issues with command deletion and renaming} {
- set x {}
- testdel {} foo {lappend x deleted; rename foo bar}
- rename foo {}
- lappend x | [info command bar]
- } {deleted | {}}
- test rename-4.5 {reentrancy issues with command deletion and renaming} {
- set env(value) before
- interp create foo
- testdel foo cmd {set env(value) deleted}
+test rename-4.1 {reentrancy issues with command deletion and renaming} testdel {
+ set x {}
+ testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]}
+ rename foo bar
+ lappend x |
+ rename bar {}
+ set x
+} {| deleted {}}
+test rename-4.2 {reentrancy issues with command deletion and renaming} testdel {
+ set x {}
+ testdel {} foo {lappend x deleted; rename foo bar}
+ rename foo {}
+ set x
+} {deleted}
+test rename-4.3 {reentrancy issues with command deletion and renaming} testdel {
+ set x {}
+ testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}}
+ rename foo {}
+ lappend x |
+ rename foo {}
+ set x
+} {deleted | deleted2}
+test rename-4.4 {reentrancy issues with command deletion and renaming} testdel {
+ set x {}
+ testdel {} foo {lappend x deleted; rename foo bar}
+ rename foo {}
+ lappend x | [info command bar]
+} {deleted | {}}
+test rename-4.5 {reentrancy issues with command deletion and renaming} testdel {
+ set env(value) before
+ interp create foo
+ testdel foo cmd {set env(value) deleted}
+ interp delete foo
+ set env(value)
+} {deleted}
+test rename-4.6 {reentrancy issues with command deletion and renaming} testdel {
+ proc kill args {
+ interp delete foo
+ }
+ set env(value) before
+ interp create foo
+ foo alias kill kill
+ testdel foo cmd {set env(value) deleted; kill}
+ list [catch {foo eval {rename cmd {}}} msg] $msg $env(value)
+} {0 {} deleted}
+test rename-4.7 {reentrancy issues with command deletion and renaming} testdel {
+ proc kill args {
interp delete foo
- set env(value)
- } {deleted}
- test rename-4.6 {reentrancy issues with command deletion and renaming} {
- proc kill args {
- interp delete foo
- }
- set env(value) before
- interp create foo
- foo alias kill kill
- testdel foo cmd {set env(value) deleted; kill}
- list [catch {foo eval {rename cmd {}}} msg] $msg $env(value)
- } {0 {} deleted}
- test rename-4.7 {reentrancy issues with command deletion and renaming} {
- proc kill args {
- interp delete foo
- }
- set env(value) before
- interp create foo
- foo alias kill kill
- testdel foo cmd {set env(value) deleted; kill}
- list [catch {interp delete foo} msg] $msg $env(value)
- } {0 {} deleted}
- if {[info exists env(value)]} {
- unset env(value)
}
+ set env(value) before
+ interp create foo
+ foo alias kill kill
+ testdel foo cmd {set env(value) deleted; kill}
+ list [catch {interp delete foo} msg] $msg $env(value)
+} {0 {} deleted}
+if {[info exists env(value)]} {
+ unset env(value)
}
# Save the unknown procedure which is modified by the following test.
diff --git a/tests/safe.test b/tests/safe.test
index 21fad12..ba6812f 100644
--- a/tests/safe.test
+++ b/tests/safe.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: safe.test,v 1.13 2002/05/10 18:47:11 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.14 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -18,7 +18,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
foreach i [interp slaves] {
- interp delete $i
+ interp delete $i
}
# Force actual loading of the safe package
@@ -32,7 +32,6 @@ test safe-1.1 {safe::interpConfigure syntax} {
list [catch {safe::interpConfigure} msg] $msg;
} {1 {no value given for parameter "slave" (use -help for full usage) :
slave name () name of the slave}}
-
test safe-1.2 {safe::interpCreate syntax} {
list [catch {safe::interpCreate -help} msg] $msg;
} {1 {Usage information:
@@ -46,7 +45,6 @@ test safe-1.2 {safe::interpCreate syntax} {
-nestedLoadOk boolflag (false) allow nested loading
-nested boolean (false) nested loading
-deleteHook script () delete hook}}
-
test safe-1.3 {safe::interpInit syntax} {
list [catch {safe::interpInit -noStatics} msg] $msg;
} {1 {bad value "-noStatics" for parameter
@@ -123,8 +121,6 @@ test safe-4.3 {safe::interpDelete, state array (not a public api)} {
list $m1 $m2
} "{}\
{can't read \"[safe::InterpStateName a](foo)\": no such variable}"
-
-
test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
catch {safe::interpDelete a}
safe::interpCreate a
@@ -132,7 +128,6 @@ test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
a eval exit
catch {namespace eval safe {set [InterpStateName a](foo)}} msg
} 1
-
test safe-4.5 {safe::interpDelete} {
catch {safe::interpDelete a}
safe::interpCreate a
@@ -165,6 +160,7 @@ proc DI {} {
global I;
interp delete $I;
}
+
test safe-6.1 {test safe interpreters knowledge of the world} {
SI; set r [lsort [$I eval {info globals}]]; DI; set r
} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
@@ -202,7 +198,6 @@ test safe-7.1 {tests that everything works at high level} {
safe::interpDelete $i
set v
} 1.0
-
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
# should not add anything (p0)
@@ -227,8 +222,6 @@ test safe-8.1 {safe source control on file} {
$msg \
[safe::interpDelete $i] ;
} {1 {wrong # args: should be "source fileName"} {}}
-
-# test source control on file name
test safe-8.2 {safe source control on file} {
set i "a";
catch {safe::interpDelete $i}
@@ -237,7 +230,6 @@ test safe-8.2 {safe source control on file} {
$msg \
[safe::interpDelete $i] ;
} {1 {wrong # args: should be "source fileName"} {}}
-
test safe-8.3 {safe source control on file} {
set i "a";
catch {safe::interpDelete $i}
@@ -252,8 +244,6 @@ test safe-8.3 {safe source control on file} {
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}}
-
-
test safe-8.4 {safe source control on file} {
set i "a";
catch {safe::interpDelete $i}
@@ -268,8 +258,6 @@ test safe-8.4 {safe source control on file} {
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}}
-
-
test safe-8.5 {safe source control on file} {
# This tested filename == *.tcl or tclIndex, but that restriction
# was removed in 8.4a4 - hobbs
@@ -286,8 +274,6 @@ test safe-8.5 {safe source control on file} {
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}]
-
-
test safe-8.6 {safe source control on file} {
set i "a";
catch {safe::interpDelete $i}
@@ -302,8 +288,6 @@ test safe-8.6 {safe source control on file} {
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}]
-
-
test safe-8.7 {safe source control on file} {
# This tested length of filename, but that restriction
# was removed in 8.4a4 - hobbs
@@ -321,7 +305,6 @@ test safe-8.7 {safe source control on file} {
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}]
-
test safe-8.8 {safe source forbids -rsrc} {
set i "a";
catch {safe::interpDelete $i}
@@ -331,7 +314,6 @@ test safe-8.8 {safe source forbids -rsrc} {
[safe::interpDelete $i] ;
} {1 {wrong # args: should be "source fileName"} {}}
-
test safe-9.1 {safe interps' deleteHook} {
set i "a";
catch {safe::interpDelete $i}
@@ -346,7 +328,6 @@ test safe-9.1 {safe interps' deleteHook} {
safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
list [interp eval $i exit] $res
} {{} {arg1 arg2 a}}
-
test safe-9.2 {safe interps' error in deleteHook} {
set i "a";
catch {safe::interpDelete $i}
@@ -369,17 +350,13 @@ test safe-9.2 {safe interps' error in deleteHook} {
$log \
[safe::setLogCmd $prevlog; unset log];
} {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
-
-
test safe-9.3 {dual specification of statics} {
list [catch {safe::interpCreate -stat true -nostat} msg] $msg
} {1 {conflicting values given for -statics and -noStatics}}
-
test safe-9.4 {dual specification of statics} {
# no error shall occur
safe::interpDelete [safe::interpCreate -stat false -nostat]
} {}
-
test safe-9.5 {dual specification of nested} {
list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
} {1 {conflicting values given for -nested and -nestedLoadOk}}
@@ -403,45 +380,38 @@ test safe-9.6 {interpConfigure widget like behaviour} {
safe::interpConfigure $i]
} {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}}
-
# testing that nested and statics do what is advertised
# (we use a static package : Tcltest)
if {[catch {package require Tcltest} msg]} {
- puts "This application hasn't been compiled with Tcltest"
- puts "skipping remining safe test that relies on it."
+ testConstraint TcltestPackage 0
} else {
-
+ testConstraint TcltestPackage 1
# we use the Tcltest package , which has no Safe_Init
+}
-test safe-10.1 {testing statics loading} {
+test safe-10.1 {testing statics loading} TcltestPackage {
set i [safe::interpCreate]
list \
[catch {interp eval $i {load {} Tcltest}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
-
-test safe-10.2 {testing statics loading / -nostatics} {
+test safe-10.2 {testing statics loading / -nostatics} TcltestPackage {
set i [safe::interpCreate -nostatics]
list \
[catch {interp eval $i {load {} Tcltest}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {permission denied (static package)} {}}
-
-
-
-test safe-10.3 {testing nested statics loading / no nested by default} {
+test safe-10.3 {testing nested statics loading / no nested by default} TcltestPackage {
set i [safe::interpCreate]
list \
[catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {permission denied (nested load)} {}}
-
-
-test safe-10.4 {testing nested statics loading / -nestedloadok} {
+test safe-10.4 {testing nested statics loading / -nestedloadok} TcltestPackage {
set i [safe::interpCreate -nestedloadok]
list \
[catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
@@ -449,9 +419,6 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} {
[safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
-
-}
-
test safe-11.1 {testing safe encoding} {
set i [safe::interpCreate]
list \
@@ -459,7 +426,6 @@ test safe-11.1 {testing safe encoding} {
$msg \
[safe::interpDelete $i];
} {1 {wrong # args: should be "encoding option ?arg ...?"} {}}
-
test safe-11.2 {testing safe encoding} {
set i [safe::interpCreate]
list \
@@ -467,7 +433,6 @@ test safe-11.2 {testing safe encoding} {
$msg \
[safe::interpDelete $i];
} {1 {wrong # args: should be "encoding system"} {}}
-
test safe-11.3 {testing safe encoding} {
set i [safe::interpCreate]
set result [catch {
@@ -475,7 +440,6 @@ test safe-11.3 {testing safe encoding} {
} msg]
list $result $msg [safe::interpDelete $i]
} {0 1 {}}
-
test safe-11.4 {testing safe encoding} {
set i [safe::interpCreate]
set result [catch {
@@ -483,7 +447,6 @@ test safe-11.4 {testing safe encoding} {
} msg]
list $result $msg [safe::interpDelete $i]
} {0 1 {}}
-
test safe-11.5 {testing safe encoding} {
set i [safe::interpCreate]
list \
@@ -491,8 +454,6 @@ test safe-11.5 {testing safe encoding} {
$msg \
[safe::interpDelete $i];
} {0 foobar {}}
-
-
test safe-11.6 {testing safe encoding} {
set i [safe::interpCreate]
list \
@@ -500,7 +461,6 @@ test safe-11.6 {testing safe encoding} {
$msg \
[safe::interpDelete $i];
} {0 foobar {}}
-
test safe-11.7 {testing safe encoding} {
set i [safe::interpCreate]
list \
@@ -508,8 +468,6 @@ test safe-11.7 {testing safe encoding} {
$msg \
[safe::interpDelete $i];
} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
-
-
test safe-11.8 {testing safe encoding} {
set i [safe::interpCreate]
list \
diff --git a/tests/socket.test b/tests/socket.test
index e575aa6..9a7bfc2 100644
--- a/tests/socket.test
+++ b/tests/socket.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: socket.test,v 1.29 2004/03/17 18:14:18 das Exp $
+# RCS: @(#) $Id: socket.test,v 1.30 2004/05/19 20:15:32 dkf Exp $
# Running socket tests with a remote server:
# ------------------------------------------
@@ -148,8 +148,8 @@ if {$doTestsWithRemoteServer} {
}
# Some tests are run only if we are doing testing against a remote server.
-set ::tcltest::testConstraints(doTestsWithRemoteServer) $doTestsWithRemoteServer
-if {$doTestsWithRemoteServer == 0} {
+testConstraint doTestsWithRemoteServer $doTestsWithRemoteServer
+if {![testConstraint doTestsWithRemoteServer]} {
if {[string first s $::tcltest::verbose] != -1} {
puts "Skipping tests with remote server. See tests/socket.test for"
puts "information on how to run remote server."
@@ -162,7 +162,7 @@ if {$doTestsWithRemoteServer == 0} {
# remote server.
#
-if {$doTestsWithRemoteServer == 1} {
+if {[testConstraint doTestsWithRemoteServer]} {
proc sendCommand {c} {
global commandSocket
diff --git a/tests/string.test b/tests/string.test
index 083e145..b64fc4d 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,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.39 2003/07/04 10:30:27 dkf Exp $
+# RCS: @(#) $Id: string.test,v 1.40 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -21,8 +21,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Some tests require the testobj command
-set ::tcltest::testConstraints(testobj) \
- [expr {[info commands testobj] != {}}]
+testConstraint testobj [expr {[info commands testobj] != {}}]
test string-1.1 {error conditions} {
list [catch {string gorp a b} msg] $msg
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 14b0107..13a407c 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -15,7 +15,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: stringComp.test,v 1.6 2003/02/18 02:25:45 hobbs Exp $
+# RCS: @(#) $Id: stringComp.test,v 1.7 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -24,8 +24,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Some tests require the testobj command
-set ::tcltest::testConstraints(testobj) \
- [expr {[info commands testobj] != {}}]
+testConstraint testobj [expr {[info commands testobj] != {}}]
test string-1.1 {error conditions} {
proc foo {} {string gorp a b}
diff --git a/tests/stringObj.test b/tests/stringObj.test
index e3bdbee..90ec9c3 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -12,27 +12,22 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: stringObj.test,v 1.15 2003/02/11 18:46:33 hobbs Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.16 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testobj\""
- puts "command, so I can't test the Tcl type and object support."
- ::tcltest::cleanupTests
- return
-}
+testConstraint testobj [llength [info commands testobj]]
-test stringObj-1.1 {string type registration} {
+test stringObj-1.1 {string type registration} testobj {
set t [testobj types]
set first [string first "string" $t]
set result [expr {$first != -1}]
} {1}
-test stringObj-2.1 {Tcl_NewStringObj} {
+test stringObj-2.1 {Tcl_NewStringObj} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [teststringobj set 1 abcd]
@@ -40,7 +35,7 @@ test stringObj-2.1 {Tcl_NewStringObj} {
lappend result [testobj refcount 1]
} {{} abcd string 2}
-test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
+test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -48,7 +43,7 @@ test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} xyz string 2}
-test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
+test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 512]
@@ -57,47 +52,47 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 512 foo string 2}
-test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {
+test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} testobj {
testobj freeallvars
teststringobj set 1 test
teststringobj setlength 1 3
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {3 4 tes}
-test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {
+test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj setlength 1 10
list [teststringobj length 1] [teststringobj length2 1]
} {10 10}
-test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {
+test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj append 1 xyzq -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {10 20 abcdefxyzq}
-test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {
+test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} testobj {
testobj freeallvars
testobj newobj 1
teststringobj setlength 1 0
list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
-test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} {
+test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} testobj {
testobj freeallvars
testintobj set2 1 43
teststringobj append 1 xyz -1
teststringobj get 1
} {43xyz}
-test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} {
+test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} testobj {
testobj freeallvars
teststringobj set 1 {x y }
teststringobj append 1 bbCCddEE 4
teststringobj append 1 123 -1
teststringobj get 1
} {x y bbCC123}
-test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
+test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj {
testobj freeallvars
teststringobj set 1 xyz
teststringobj setlength 1 15
@@ -111,37 +106,37 @@ test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
[teststringobj get 1]
} {15 15 16 32 xy12345678abcdef}
-test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} {
+test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
testobj freeallvars
teststringobj set2 1 [list a b]
teststringobj appendstrings 1 xyz { 1234 } foo
teststringobj get 1
} {a bxyz 1234 foo}
-test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} {
+test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} testobj {
testobj freeallvars
teststringobj set 1 abc
teststringobj appendstrings 1
list [teststringobj length 1] [teststringobj get 1]
} {3 abc}
-test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} {
+test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} testobj {
testobj freeallvars
teststringobj set 1 abc
teststringobj appendstrings 1 {} {} {} {}
list [teststringobj length 1] [teststringobj get 1]
} {3 abc}
-test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} {
+test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} testobj {
testobj freeallvars
teststringobj set 1 abc
teststringobj appendstrings 1 { 123 } abcdefg
list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
-test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {
+test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 123 abcdefg
list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
} {10 10 123abcdefg}
-test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
+test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -150,7 +145,7 @@ test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {10 10 ab34567890}
-test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
+test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -159,39 +154,39 @@ test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {11 22 ab34567890x}
-test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
+test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
-test stringObj-7.1 {SetStringFromAny procedure} {
+test stringObj-7.1 {SetStringFromAny procedure} testobj {
testobj freeallvars
teststringobj set2 1 [list a b]
teststringobj append 1 x -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {4 8 {a bx}}
-test stringObj-7.2 {SetStringFromAny procedure, null object} {
+test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {0 0 {}}
-test stringObj-7.3 {SetStringFromAny called with non-string obj} {
+test stringObj-7.3 {SetStringFromAny called with non-string obj} testobj {
set x 2345
list [incr x] [testobj objtype $x] [string index $x end] \
[testobj objtype $x]
} {2346 int 6 string}
-test stringObj-7.4 {SetStringFromAny called with string obj} {
+test stringObj-7.4 {SetStringFromAny called with string obj} testobj {
set x "abcdef"
list [string length $x] [testobj objtype $x] \
[string length $x] [testobj objtype $x]
} {6 string 6 string}
-test stringObj-8.1 {DupStringInternalRep procedure} {
+test stringObj-8.1 {DupStringInternalRep procedure} testobj {
testobj freeallvars
teststringobj set 1 {}
teststringobj append 1 abcde -1
@@ -201,28 +196,28 @@ test stringObj-8.1 {DupStringInternalRep procedure} {
[teststringobj length 2] [teststringobj length2 2] \
[teststringobj ualloc 2] [teststringobj get 2]
} {5 10 0 abcde 5 5 0 abcde}
-test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} {
+test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
set x abcï¿®ghi
string length $x
set y $x
list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
-test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} {
+test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj {
set x abcï¿®ghi
set y $x
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
-test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} {
+test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj {
set x abcdefghi
string length $x
set y $x
list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcdefghijkl abcdefghi string string}
-test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} {
+test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj {
set x abcdefghi
set y $x
string length $x
@@ -230,14 +225,14 @@ test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} {
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcdefghijkl abcdefghi string string}
-test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {
+test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} testobj {
set x abcï¿®ghi
set y ®¿ï
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcï¿®ghi®¿ï ®¿ï string none}
-test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} {
+test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj {
set x abcï¿®ghi
string length $x
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
@@ -245,61 +240,61 @@ test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} {
} {string abcï¿®ghiabcï¿®ghi string\
abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\
string}
-test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {
+test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} testobj {
set x abcdefghi
set y ®¿ï
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcdefghi®¿ï ®¿ï string none}
-test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {
+test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} testobj {
set x abcdefghi
set y jkl
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcdefghijkl jkl string none}
-test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} {
+test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj {
set x abcdefghi
string length $x
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
string}
-test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {
+test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} testobj {
set x abcï¿®ghi
set y jkl
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcï¿®ghijkl jkl string none}
-test stringObj-9.7 {TclAppendObjToObj, integer src & dest} {
+test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj {
set x [expr {4 * 5}]
set y [expr {4 + 5}]
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[testobj objtype $x] [append x $y] [testobj objtype $x] \
[testobj objtype $y]
} {int int 209 string 2099 string int}
-test stringObj-9.8 {TclAppendObjToObj, integer src & dest} {
+test stringObj-9.8 {TclAppendObjToObj, integer src & dest} testobj {
set x [expr {4 * 5}]
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} {int 2020 string 20202020 string}
-test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} {
+test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj {
set x abcdefghi
set y [expr {4 + 5}]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string int abcdefghi9 9 string int}
-test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} {
+test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj {
set x abcï¿®ghi
set y [expr {4 + 5}]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string int abcï¿®ghi9 9 string int}
-test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} {
+test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj {
# bug 2678, in <=8.2.0, the second obj (the one to append) in
# Tcl_AppendObjToObj was not correctly checked to see if it was
# all one byte chars, so a unicode string would be added as one
@@ -317,12 +312,12 @@ test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} {
set q
} {a b c d e f a ü b å c ï}
-test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {
+test stringObj-10.1 {Tcl_GetRange with all byte-size chars} testobj {
set x "abcdef"
list [testobj objtype $x] [set y [string range $x 1 end-1]] \
[testobj objtype $x] [testobj objtype $y]
} [list none bcde string string]
-test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {
+test stringObj-10.2 {Tcl_GetRange with some mixed width chars} testobj {
# Because this test does not use \uXXXX notation below instead of
# hardcoding the values, it may fail in multibyte locales. However,
# we need to test that the parser produces untyped objects even when there
@@ -332,7 +327,7 @@ test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {
list [testobj objtype $x] [set y [string range $x 1 end-1]] \
[testobj objtype $x] [testobj objtype $y]
} [list none "bc\u00EF\u00EFde" string string]
-test stringObj-10.3 {Tcl_GetRange with some mixed width chars} {
+test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj {
# set x "abcïïdef"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
@@ -341,7 +336,7 @@ test stringObj-10.3 {Tcl_GetRange with some mixed width chars} {
list [testobj objtype $x] [set y [string range $x 1 end-1]] \
[testobj objtype $x] [testobj objtype $y]
} [list string "bc\u00EF\u00EFde" string string]
-test stringObj-10.4 {Tcl_GetRange with some mixed width chars} {
+test stringObj-10.4 {Tcl_GetRange with some mixed width chars} testobj {
# set a "ïa¿b®cï¿d®"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
@@ -358,71 +353,71 @@ test stringObj-10.4 {Tcl_GetRange with some mixed width chars} {
\u00AEc \
{}]
-test stringObj-11.1 {UpdateStringOfString} {
+test stringObj-11.1 {UpdateStringOfString} testobj {
set x 2345
list [string index $x end] [testobj objtype $x] [incr x] \
[testobj objtype $x]
} {5 string 2346 int}
-test stringObj-12.1 {Tcl_GetUniChar with byte-size chars} {
+test stringObj-12.1 {Tcl_GetUniChar with byte-size chars} testobj {
set x "abcdefghi"
list [string index $x 0] [string index $x 1]
} {a b}
-test stringObj-12.2 {Tcl_GetUniChar with byte-size chars} {
+test stringObj-12.2 {Tcl_GetUniChar with byte-size chars} testobj {
set x "abcdefghi"
list [string index $x 3] [string index $x end]
} {d i}
-test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} {
+test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj {
set x "abcdefghi"
list [string index $x end] [string index $x end-1]
} {i h}
-test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} {
+test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj {
string index "ïa¿b®c®¿dï" 0
} "ï"
-test stringObj-12.5 {Tcl_GetUniChar} {
+test stringObj-12.5 {Tcl_GetUniChar} testobj {
set x "ïa¿b®c®¿dï"
list [string index $x 4] [string index $x 0]
} {® ï}
-test stringObj-12.6 {Tcl_GetUniChar} {
+test stringObj-12.6 {Tcl_GetUniChar} testobj {
string index "ïa¿b®cï¿d®" end
} "®"
-test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} {
+test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj {
set a ""
list [string length $a] [string length $a]
} {0 0}
-test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} {
+test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} testobj {
string length "a"
} 1
-test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} {
+test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj {
set a "abcdef"
list [string length $a] [string length $a]
} {6 6}
-test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} {
+test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
string length "®"
} 1
-test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} {
+test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
# string length "￮￮"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
} 6
-test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} {
+test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
# set a "ïa¿b®cï¿d®"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
list [string length $a] [string length $a]
} {10 10}
-test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {
+test stringObj-13.7 {Tcl_GetCharLength with identity nulls} testobj {
# SF bug #684699
string length [encoding convertfrom identity \x00]
} 1
-test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {
+test stringObj-13.8 {Tcl_GetCharLength with identity nulls} testobj {
string length [encoding convertfrom identity \x01\x00\x02]
} 3
-test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} {
+test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj {
teststringobj set 1 foo
teststringobj getunicode 1
teststringobj append 1 bar -1
@@ -433,7 +428,9 @@ test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} {
teststringobj get 1
} {bar}
-testobj freeallvars
+if {[testConstraint testobj]} {
+ testobj freeallvars
+}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/thread.test b/tests/thread.test
index 2686720..216d498 100644
--- a/tests/thread.test
+++ b/tests/thread.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: thread.test,v 1.10 2000/05/02 22:02:36 kupries Exp $
+# RCS: @(#) $Id: thread.test,v 1.11 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -19,11 +19,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Some tests require the testthread command
-set ::tcltest::testConstraints(testthread) \
- [expr {[info commands testthread] != {}}]
-
-if {$::tcltest::testConstraints(testthread)} {
+testConstraint testthread [expr {[info commands testthread] != {}}]
+if {[testConstraint testthread]} {
testthread errorproc ThreadError
proc ThreadError {id info} {
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index e863d3b..32b3d68 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.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: unixFCmd.test,v 1.19 2003/05/14 19:21:25 das Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.20 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -229,14 +229,15 @@ test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {
# Find a group that exists on this system, or else skip tests that require
# groups
-set ::tcltest::testConstraints(foundGroup) 0
+set foundgroup 0
if {$tcl_platform(platform) == "unix"} {
catch {
set groupList [exec groups]
set group [lindex $groupList 0]
- set ::tcltest::testConstraints(foundGroup) 1
+ set foundgroup 1
}
}
+testConstraint foundGroup $foundgroup
#groups hard to test
test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {
@@ -326,16 +327,17 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
} {1 {error getting working directory name:}}
# check whether -readonly attribute is supported
-set ::tcltest::testConstraints(readonlyAttr) 0
+set roattr 0
if {$tcl_platform(platform) == "unix"} {
catch {file delete -force -- foo.test}
close [open foo.test w]
catch {
file attributes foo.test -readonly
- set ::tcltest::testConstraints(readonlyAttr) 1
+ set roattr 1
}
file delete -force -- foo.test
}
+testConstraint readonlyAttr $roattr
test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unixOnly notRoot readonlyAttr} {
catch {file delete -force -- foo.test}
diff --git a/tests/unixFile.test b/tests/unixFile.test
index cc3b9b4..22c3885 100644
--- a/tests/unixFile.test
+++ b/tests/unixFile.test
@@ -9,19 +9,14 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: unixFile.test,v 1.7 2002/07/05 10:38:43 dkf Exp $
+# RCS: @(#) $Id: unixFile.test,v 1.8 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testfindexecutable\""
- puts "command, so I can't test the Tcl_FindExecutable function"
- ::tcltest::cleanupTests
- return
-}
+testConstraint testfindexecutable [llength [info commands testfindexecutable]]
set oldpwd [pwd]
cd [temporaryDirectory]
@@ -32,31 +27,31 @@ catch {
}
set absPath [file join [temporaryDirectory] junk]
-test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.1 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) ""
testfindexecutable junk
} $absPath
-test unixFile-1.2 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.2 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) "/dummy"
testfindexecutable junk
} {}
-test unixFile-1.3 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.3 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) "/dummy:[pwd]"
testfindexecutable junk
} $absPath
-test unixFile-1.4 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.4 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) "/dummy:"
testfindexecutable junk
} $absPath
-test unixFile-1.5 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.5 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) "/dummy:/dummy"
testfindexecutable junk
} {}
-test unixFile-1.6 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.6 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) "/dummy::/dummy"
testfindexecutable junk
} $absPath
-test unixFile-1.7 {Tcl_FindExecutable} {unixOnly} {
+test unixFile-1.7 {Tcl_FindExecutable} {testfindexecutable unixOnly} {
set env(PATH) ":/dummy"
testfindexecutable junk
} $absPath
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index d8f5a4c..2840813 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.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: unixNotfy.test,v 1.13 2003/10/06 14:32:22 dgp Exp $
+# RCS: @(#) $Id: unixNotfy.test,v 1.14 2004/05/19 20:15:32 dkf Exp $
# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
@@ -21,21 +21,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-if {[info exists tk_version]} {
- puts "When run in a Tk shell, these tests run hang. Skipping tests ..."
- ::tcltest::cleanupTests
- return
-}
-
-set ::tcltest::testConstraints(testthread) \
- [expr {[info commands testthread] != {}}]
+# When run in a Tk shell, these tests hang.
+testConstraint noTk [expr {![info exists tk_version]}]
+testConstraint testthread [expr {[info commands testthread] != {}}]
# The next two tests will hang if threads are enabled because the notifier
# will not necessarily wait for ever in this case, so it does not generate
# an error.
test unixNotfy-1.1 {Tcl_DeleteFileHandler} \
- -constraints {unixOnly && !testthread} \
+ -constraints {noTk && unixOnly && !testthread} \
-body {
catch {vwait x}
set f [open [makeFile "" foo] w]
@@ -49,9 +44,8 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} \
catch { close $f }
catch { removeFile foo }
}
-
test unixNotfy-1.2 {Tcl_DeleteFileHandler} \
- -constraints {unixOnly && !testthread} \
+ -constraints {noTk && unixOnly && !testthread} \
-body {
catch {vwait x}
set f1 [open [makeFile "" foo] w]
@@ -73,7 +67,7 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} \
}
test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
- -constraints {unixOnly testthread} \
+ -constraints {noTk unixOnly testthread} \
-body {
update
set f [open [makeFile "" foo] w]
@@ -91,9 +85,8 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
catch { close $f }
catch { removeFile foo }
}
-
test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
- -constraints {unixOnly testthread} \
+ -constraints {noTk unixOnly testthread} \
-body {
update
set f1 [open [makeFile "" foo] w]
diff --git a/tests/util.test b/tests/util.test
index 6c4db29..ae3d0c5 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -7,20 +7,13 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: util.test,v 1.13 2003/08/27 20:29:36 dgp Exp $
+# RCS: @(#) $Id: util.test,v 1.14 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testobj\""
- puts "command, so I can't test the Tcl type and object support."
- ::tcltest::cleanupTests
- return
-}
-
test util-1.1 {TclFindElement procedure - binary element in middle of list} {
lindex {0 foo\x00help 1} 1
} "foo\x00help"
@@ -347,8 +340,7 @@ test util-8.1 {TclNeedSpace - correct UTF8 handling} {
set result
} "\u5420 foo"
-set ::tcltest::testConstraints(testdstring) \
- [expr {[info commands testdstring] != {}}]
+testConstraint testdstring [expr {[info commands testdstring] != {}}]
test util-8.2 {TclNeedSpace - correct UTF8 handling} testdstring {
# Bug 411825
diff --git a/tests/var.test b/tests/var.test
index c675d63..93e698b 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.23 2004/04/28 13:11:35 msofer Exp $
+# RCS: @(#) $Id: var.test,v 1.24 2004/05/19 20:15:32 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -22,6 +22,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+testConstraint testupvar [llength [info commands testupvar]]
+testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
+testConstraint testsetnoerr [info commands testsetnoerr]
+
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {unset xx}
@@ -202,30 +206,28 @@ test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
p
}
} {1998}
-if {[info commands testupvar] != {}} {
- test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} {
- catch {unset a}
- set a 123321
- proc p {} {
- # create global xx linked to global a
- testupvar 1 a {} xx global
+test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} testupvar {
+ catch {unset a}
+ set a 123321
+ proc p {} {
+ # create global xx linked to global a
+ testupvar 1 a {} xx global
+ }
+ list [p] $xx [set xx 789] $a
+} {{} 123321 789 789}
+test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
+ catch {unset a}
+ set a 456
+ namespace eval test_ns_var {
+ catch {unset ::test_ns_var::vv}
+ proc p {} {
+ # create namespace var vv linked to global a
+ testupvar 1 a {} vv namespace
}
- list [p] $xx [set xx 789] $a
- } {{} 123321 789 789}
- test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} {
- catch {unset a}
- set a 456
- namespace eval test_ns_var {
- catch {unset ::test_ns_var::vv}
- proc p {} {
- # create namespace var vv linked to global a
- testupvar 1 a {} vv namespace
- }
- p
- }
- list $test_ns_var::vv [set test_ns_var::vv 123] $a
- } {456 123 123}
-}
+ p
+ }
+ list $test_ns_var::vv [set test_ns_var::vv 123] $a
+} {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
catch {unset aaaaa}
catch {unset xxxxx}
@@ -278,24 +280,22 @@ test var-3.11 {MakeUpvar, my var looks like array elem} -body {
upvar #0 aaaaa foo(bar)
} -returnCodes 1 -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
-if {[info commands testgetvarfullname] != {}} {
- test var-4.1 {Tcl_GetVariableName, global variable} {
- catch {unset a}
- set a 123
- testgetvarfullname a global
- } ::a
- test var-4.2 {Tcl_GetVariableName, namespace variable} {
- namespace eval test_ns_var {
- variable george
- testgetvarfullname george namespace
- }
- } ::test_ns_var::george
- test var-4.3 {Tcl_GetVariableName, variable can't be array element} {
- catch {unset a}
- set a(1) foo
- list [catch {testgetvarfullname a(1) global} msg] $msg
- } {1 {unknown variable "a(1)"}}
-}
+test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
+ catch {unset a}
+ set a 123
+ testgetvarfullname a global
+} ::a
+test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
+ namespace eval test_ns_var {
+ variable george
+ testgetvarfullname george namespace
+ }
+} ::test_ns_var::george
+test var-4.3 {Tcl_GetVariableName, variable can't be array element} testgetvarfullname {
+ catch {unset a}
+ set a(1) foo
+ list [catch {testgetvarfullname a(1) global} msg] $msg
+} {1 {unknown variable "a(1)"}}
test var-5.1 {Tcl_GetVariableFullName, global variable} {
catch {unset a}
@@ -527,11 +527,7 @@ test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var
list [unset test_ns_var::v] $test_ns_var::info
} {{} {test_ns_var::v {} u}}
-if {[info commands testsetnoerr] == {}} {
- puts "This application hasn't been compiled with the \"testsetnoerr\""
- puts "command, so I can't test TclSetVar etc."
-} else {
-test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr {
catch {unset u}; catch {unset v}
list \
[set u a; testsetnoerr u] \
@@ -539,7 +535,7 @@ test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
[testseterr u] \
[unset v; testseterr v b]
} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} testsetnoerr {
catch {namespace delete ns}
namespace eval ns {variable u a; variable v}
list \
@@ -548,46 +544,46 @@ test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
[testseterr ns::u] \
[unset ns::v; testseterr ns::v b]
} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.3 {behaviour of TclGetVar no variable} {
+test var-9.3 {behaviour of TclGetVar no variable} testsetnoerr {
catch {unset u}
list \
[catch {testsetnoerr u} res] $res \
[catch {testseterr u} res] $res
} {1 {before get} 1 {can't read "u": no such variable}}
-test var-9.4 {behaviour of TclGetVar no namespace variable} {
+test var-9.4 {behaviour of TclGetVar no namespace variable} testsetnoerr {
catch {namespace delete ns}
namespace eval ns {}
list \
[catch {testsetnoerr ns::w} res] $res \
[catch {testseterr ns::w} res] $res
} {1 {before get} 1 {can't read "ns::w": no such variable}}
-test var-9.5 {behaviour of TclGetVar no namespace} {
+test var-9.5 {behaviour of TclGetVar no namespace} testsetnoerr {
catch {namespace delete ns}
list \
[catch {testsetnoerr ns::u} res] $res \
[catch {testseterr ns::v} res] $res
} {1 {before get} 1 {can't read "ns::v": no such variable}}
-test var-9.6 {behaviour of TclSetVar no namespace} {
+test var-9.6 {behaviour of TclSetVar no namespace} testsetnoerr {
catch {namespace delete ns}
list \
[catch {testsetnoerr ns::v 1} res] $res \
[catch {testseterr ns::v 1} res] $res
} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
-test var-9.7 {behaviour of TclGetVar array variable} {
+test var-9.7 {behaviour of TclGetVar array variable} testsetnoerr {
catch {unset arr}
set arr(1) 1;
list \
[catch {testsetnoerr arr} res] $res \
[catch {testseterr arr} res] $res
} {1 {before get} 1 {can't read "arr": variable is array}}
-test var-9.8 {behaviour of TclSetVar array variable} {
+test var-9.8 {behaviour of TclSetVar array variable} testsetnoerr {
catch {unset arr}
set arr(1) 1
list \
[catch {testsetnoerr arr 2} res] $res \
[catch {testseterr arr 2} res] $res
} {1 {before set} 1 {can't set "arr": variable is array}}
-test var-9.9 {behaviour of TclGetVar read trace success} {
+test var-9.9 {behaviour of TclGetVar read trace success} testsetnoerr {
proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
catch {unset u}; catch {unset v}
set u 10
@@ -597,7 +593,7 @@ test var-9.9 {behaviour of TclGetVar read trace success} {
[testsetnoerr u] \
[testseterr v]
} {{before get 1} {before get 2}}
-test var-9.10 {behaviour of TclGetVar read trace error} {
+test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
proc writeonly args {error "write-only"}
set v 456
trace var v r writeonly
@@ -605,7 +601,7 @@ test var-9.10 {behaviour of TclGetVar read trace error} {
[catch {testsetnoerr v} msg] $msg \
[catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
-test var-9.11 {behaviour of TclSetVar write trace success} {
+test var-9.11 {behaviour of TclSetVar write trace success} testsetnoerr {
proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
catch {unset u}; catch {unset v}
set v 1
@@ -615,7 +611,7 @@ test var-9.11 {behaviour of TclSetVar write trace success} {
[testsetnoerr u 2] \
[testseterr v 3]
} {{before set 4} {before set 6}}
-test var-9.12 {behaviour of TclSetVar write trace error} {
+test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
proc readonly args {error "read-only"}
set v 456
trace var v w readonly
@@ -623,12 +619,11 @@ test var-9.12 {behaviour of TclSetVar write trace error} {
[catch {testsetnoerr v 2} msg] $msg $v \
[catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}
-}
+
test var-10.1 {can't nest arrays with array set} {
catch {unset arr}
list [catch {array set arr(x) {a 1 b 2}} res] $res
} {1 {can't set "arr(x)": variable isn't array}}
-
test var-10.2 {can't nest arrays with array set} {
catch {unset arr}
list [catch {array set arr(x) {}} res] $res
diff --git a/tests/winDde.test b/tests/winDde.test
index 5600984..850d839 100644
--- a/tests/winDde.test
+++ b/tests/winDde.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: winDde.test,v 1.19 2003/10/06 14:32:22 dgp Exp $
+# RCS: @(#) $Id: winDde.test,v 1.20 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -22,10 +22,10 @@ if {$tcl_platform(platform) == "windows"} {
set lib [lindex [glob -directory [file join [pwd] [file dirname \
[info nameofexecutable]]] tcldde*.dll] 0]
load $lib dde
+ testConstraint dde 1
}] {
+ testConstraint dde 0
puts "WARNING: Unable to find the dde package. Skipping dde tests."
- ::tcltest::cleanupTests
- return
}
}
@@ -112,56 +112,49 @@ proc createChildProcess { ddeServerName {handler {}}} {
# -------------------------------------------------------------------------
-test winDde-1.1 {Settings the server's topic name} {pcOnly} {
+test winDde-1.1 {Settings the server's topic name} {pcOnly dde} {
list [dde servername foobar] [dde servername] [dde servername self]
} {foobar foobar self}
-test winDde-2.1 {Checking for other services} {pcOnly} {
+test winDde-2.1 {Checking for other services} {pcOnly dde} {
expr [llength [dde services {} {}]] >= 0
} 1
-
test winDde-2.2 {Checking for existence, with service and topic specified} \
- {pcOnly} {
+ {pcOnly dde} {
llength [dde services TclEval self]
} 1
-
test winDde-2.3 {Checking for existence, with only the service specified} \
- {pcOnly} {
+ {pcOnly dde} {
expr [llength [dde services TclEval {}]] >= 1
} 1
-
test winDde-2.4 {Checking for existence, with only the topic specified} \
- {pcOnly} {
+ {pcOnly dde} {
expr [llength [dde services {} self]] >= 1
} 1
# -------------------------------------------------------------------------
-test winDde-3.1 {DDE execute locally} {pcOnly} {
+test winDde-3.1 {DDE execute locally} {pcOnly dde} {
set a ""
dde execute TclEval self {set a "foo"}
set a
} foo
-
-test winDde-3.2 {DDE execute -async locally} {pcOnly} {
+test winDde-3.2 {DDE execute -async locally} {pcOnly dde} {
set a ""
dde execute -async TclEval self {set a "foo"}
update
set a
} foo
-
-test winDde-3.3 {DDE request locally} {pcOnly} {
+test winDde-3.3 {DDE request locally} {pcOnly dde} {
set a ""
dde execute TclEval self {set a "foo"}
dde request TclEval self a
} foo
-
-test winDde-3.4 {DDE eval locally} {pcOnly} {
+test winDde-3.4 {DDE eval locally} {pcOnly dde} {
set a ""
dde eval self set a "foo"
} foo
-
-test winDde-3.5 {DDE request locally} {pcOnly} {
+test winDde-3.5 {DDE request locally} {pcOnly dde} {
set a ""
dde execute TclEval self {set a "foo"}
dde request -binary TclEval self a
@@ -169,7 +162,7 @@ test winDde-3.5 {DDE request locally} {pcOnly} {
# -------------------------------------------------------------------------
-test winDde-4.1 {DDE execute remotely} {stdio pcOnly} {
+test winDde-4.1 {DDE execute remotely} {stdio pcOnly dde} {
set a ""
set name child-4.1
set child [createChildProcess $name]
@@ -178,8 +171,7 @@ test winDde-4.1 {DDE execute remotely} {stdio pcOnly} {
update
set a
} ""
-
-test winDde-4.2 {DDE execute async remotely} {stdio pcOnly} {
+test winDde-4.2 {DDE execute async remotely} {stdio pcOnly dde} {
set a ""
set name child-4.2
set child [createChildProcess $name]
@@ -188,8 +180,7 @@ test winDde-4.2 {DDE execute async remotely} {stdio pcOnly} {
update
set a
} ""
-
-test winDde-4.3 {DDE request remotely} {stdio pcOnly} {
+test winDde-4.3 {DDE request remotely} {stdio pcOnly dde} {
set a ""
set name chile-4.3
set child [createChildProcess $name]
@@ -199,8 +190,7 @@ test winDde-4.3 {DDE request remotely} {stdio pcOnly} {
update
set a
} foo
-
-test winDde-4.4 {DDE eval remotely} {stdio pcOnly} {
+test winDde-4.4 {DDE eval remotely} {stdio pcOnly dde} {
set a ""
set name child-4.4
set child [createChildProcess $name]
@@ -212,388 +202,260 @@ test winDde-4.4 {DDE eval remotely} {stdio pcOnly} {
# -------------------------------------------------------------------------
-test winDde-5.1 {check for bad arguments} {pcOnly} {
+test winDde-5.1 {check for bad arguments} {pcOnly dde} {
catch {dde execute "" "" "" ""} result
set result
} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-
-test winDde-5.2 {check for bad arguments} {pcOnly} {
+test winDde-5.2 {check for bad arguments} {pcOnly dde} {
catch {dde execute "" "" ""} result
set result
} {cannot execute null data}
-
-test winDde-5.3 {check for bad arguments} {pcOnly} {
+test winDde-5.3 {check for bad arguments} {pcOnly dde} {
catch {dde execute -foo "" "" ""} result
set result
} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-
-test winDde-5.4 {DDE eval bad arguments} {pcOnly} {
+test winDde-5.4 {DDE eval bad arguments} {pcOnly dde} {
list [catch {dde eval "" "foo"} msg] $msg
} {1 {invalid service name ""}}
# -------------------------------------------------------------------------
-test winDde-6.1 {DDE servername bad arguments} \
- -constraints pcOnly \
- -body {list [catch {dde servername -z -z -z} msg] $msg} \
- -result {1 {wrong # args: should be "dde servername ?-force? ?-handler proc? ?--? ?serverName?"}}
-
-test winDde-6.2 {DDE servername set name} \
- -constraints pcOnly \
+test winDde-6.1 {DDE servername bad arguments} -constraints {pcOnly dde} -body {
+ dde servername -z -z -z
+} -returnCodes error -result {wrong # args: should be "dde servername ?-force? ?-handler proc? ?--? ?serverName?"}
+test winDde-6.2 {DDE servername set name} -constraints {pcOnly dde} \
-body {dde servername -- winDde-6.2} \
-result {winDde-6.2}
-
-test winDde-6.3 {DDE servername set exact name} \
- -constraints pcOnly \
+test winDde-6.3 {DDE servername set exact name} -constraints {pcOnly dde} \
-body {dde servername -force winDde-6.3} \
-result {winDde-6.3}
-
-test winDde-6.4 {DDE servername set exact name} \
- -constraints pcOnly \
+test winDde-6.4 {DDE servername set exact name} -constraints {pcOnly dde} \
-body {dde servername -force -- winDde-6.4} \
-result {winDde-6.4}
-
-test winDde-6.5 {DDE remote servername collision} \
- -constraints {stdio pcOnly} \
- -setup {
- set name child-6.5
- set child [createChildProcess $name]
- } \
- -body {
- dde servername -- $name
- } \
- -cleanup {
- dde execute TclEval $name {set done 1}
- update
- } \
- -result "child-6.5 #2"
-
-test winDde-6.6 {DDE remote servername collision force} \
- -constraints {stdio pcOnly} \
- -setup {
- set name child-6.6
- set child [createChildProcess $name]
- } \
- -body {
- dde servername -force -- $name
- } \
- -cleanup {
- dde execute TclEval $name {set done 1}
- update
- } \
- -result {child-6.6}
+test winDde-6.5 {DDE remote servername collision} -constraints {stdio pcOnly dde} -setup {
+ set name child-6.5
+ set child [createChildProcess $name]
+} -body {
+ dde servername -- $name
+} -cleanup {
+ dde execute TclEval $name {set done 1}
+ update
+} -result "child-6.5 #2"
+test winDde-6.6 {DDE remote servername collision force} -constraints {stdio pcOnly dde} -setup {
+ set name child-6.6
+ set child [createChildProcess $name]
+} -body {
+ dde servername -force -- $name
+} -cleanup {
+ dde execute TclEval $name {set done 1}
+ update
+} -result {child-6.6}
# -------------------------------------------------------------------------
-test winDde-7.1 {Load DDE in slave interpreter } \
- -constraints pcOnly \
- -setup {
- interp create slave
- } \
- -body {
- slave eval [list load $lib dde]
- slave eval [list dde servername -- dde-interp-7.1]
- } \
- -cleanup {
- interp delete slave
- } \
- -result {dde-interp-7.1}
-
-test winDde-7.2 {DDE slave cleanup} \
- -constraints pcOnly \
- -setup {
- interp create slave
- slave eval [list load $lib dde]
- slave eval [list dde servername -- dde-interp-7.5]
- interp delete slave
- } \
- -body {
- dde services TclEval {}
- set s [dde services TclEval {}]
- set m [list [list TclEval dde-interp-7.5]]
- if {[lsearch -exact $s $m] != -1} {
- set s
- }
- } \
- -result {}
-
-test winDde-7.3 {DDE present in slave interp} \
- -constraints pcOnly \
- -setup {
- interp create slave
- slave eval [list load $lib dde]
- slave eval [list dde servername -- dde-interp-7.3]
- } \
- -body {
- dde services TclEval dde-interp-7.3
- } \
- -cleanup {
- interp delete slave
- } \
- -result {{TclEval dde-interp-7.3}}
-
-test winDde-7.4 {interp name collision with -force} \
- -constraints pcOnly \
- -setup {
- interp create slave
- slave eval [list load $lib dde]
- slave eval [list dde servername -- dde-interp-7.4]
- } \
- -body {
- dde servername -force -- dde-interp-7.4
- } \
- -cleanup {
- interp delete slave
- } \
- -result {dde-interp-7.4}
-
-test winDde-7.5 {interp name collision without -force} \
- -constraints pcOnly \
- -setup {
- interp create slave
- slave eval [list load $lib dde]
- slave eval [list dde servername -- dde-interp-7.5]
- } \
- -body {
- dde servername -- dde-interp-7.5
- } \
- -cleanup {
- interp delete slave
- } \
- -result "dde-interp-7.5 #2"
+test winDde-7.1 {Load DDE in slave interpreter } -constraints {pcOnly dde} -setup {
+ interp create slave
+} -body {
+ slave eval [list load $lib dde]
+ slave eval [list dde servername -- dde-interp-7.1]
+} -cleanup {
+ interp delete slave
+} -result {dde-interp-7.1}
+test winDde-7.2 {DDE slave cleanup} -constraints {pcOnly dde} -setup {
+ interp create slave
+ slave eval [list load $lib dde]
+ slave eval [list dde servername -- dde-interp-7.5]
+ interp delete slave
+} -body {
+ dde services TclEval {}
+ set s [dde services TclEval {}]
+ set m [list [list TclEval dde-interp-7.5]]
+ if {[lsearch -exact $s $m] != -1} {
+ set s
+ }
+} -result {}
+test winDde-7.3 {DDE present in slave interp} -constraints {pcOnly dde} -setup {
+ interp create slave
+ slave eval [list load $lib dde]
+ slave eval [list dde servername -- dde-interp-7.3]
+} -body {
+ dde services TclEval dde-interp-7.3
+} -cleanup {
+ interp delete slave
+} -result {{TclEval dde-interp-7.3}}
+test winDde-7.4 {interp name collision with -force} -constraints {pcOnly dde} -setup {
+ interp create slave
+ slave eval [list load $lib dde]
+ slave eval [list dde servername -- dde-interp-7.4]
+} -body {
+ dde servername -force -- dde-interp-7.4
+} -cleanup {
+ interp delete slave
+} -result {dde-interp-7.4}
+test winDde-7.5 {interp name collision without -force} -constraints {pcOnly dde} -setup {
+ interp create slave
+ slave eval [list load $lib dde]
+ slave eval [list dde servername -- dde-interp-7.5]
+} -body {
+ dde servername -- dde-interp-7.5
+} -cleanup {
+ interp delete slave
+} -result "dde-interp-7.5 #2"
# -------------------------------------------------------------------------
-test winDde-8.1 {Safe DDE load} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- } \
- -body {
- list [catch {slave eval dde servername slave} msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {1 {invalid command name "dde"}}
-
-test winDde-8.2 {Safe DDE set servername} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- } \
- -body {
- slave invokehidden dde servername slave
- } \
- -cleanup {interp delete slave} \
- -result {slave}
-
-test winDde-8.3 {Safe DDE check handler required for eval} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave invokehidden dde servername slave
- } \
- -body {
- catch {dde eval slave set a 1} msg
- } \
- -cleanup {interp delete slave} \
- -result {1}
-
-test winDde-8.4 {Safe DDE check that execute is denied} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave invokehidden dde servername slave
- } \
- -body {
- slave eval set a 1
- list [catch {
- dde execute TclEval slave {set a 2}
- slave eval set a
- } msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {0 1}
-
-test winDde-8.5 {Safe DDE check that request is denied} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave invokehidden dde servername slave
- } \
- -body {
- slave eval set a 1
- list [catch {dde request TclEval slave a} msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {1 {remote server cannot handle this command}}
-
-test winDde-8.6 {Safe DDE assign handler procedure} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
- } \
- -body {
- slave invokehidden dde servername -handler DDEACCEPT slave
- } \
- -cleanup {interp delete slave} \
- -result slave
-
-test winDde-8.7 {Safe DDE check simple command} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
- slave invokehidden dde servername -handler DDEACCEPT slave
- } \
- -body {
- list [catch {
- dde eval slave set x 1
- } msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {0 {set x 1}}
-
-test winDde-8.8 {Safe DDE check non-list command} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
- slave invokehidden dde servername -handler DDEACCEPT slave
- } \
- -body {
- list [catch {
- set s "c:\\Program Files\\Microsoft Visual Studio\\"
- dde eval slave $s
- string compare [slave eval set DDECMD] $s
- } msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {0 0}
-
-test winDde-8.9 {Safe DDE check command evaluation} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
- slave invokehidden dde servername -handler DDEACCEPT slave
- } \
- -body {
- list [catch {
- dde eval slave set x 1
- slave eval set x
- } msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {0 1}
-
-test winDde-8.10 {Safe DDE check command evaluation (2)} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
- slave invokehidden dde servername -handler DDEACCEPT slave
- } \
- -body {
- list [catch {
- dde eval slave [list set x 1]
- slave eval set x
- } msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {0 1}
-
-test winDde-8.11 {Safe DDE check command evaluation (3)} \
- -constraints pcOnly \
- -setup {
- interp create -safe slave
- slave invokehidden load $lib dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
- slave invokehidden dde servername -handler DDEACCEPT slave
- } \
- -body {
- list [catch {
- dde eval slave [list [list set x 1]]
- slave eval set x
- } msg] $msg
- } \
- -cleanup {interp delete slave} \
- -result {1 {invalid command name "set x 1"}}
+test winDde-8.1 {Safe DDE load} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+} -body {
+ list [catch {slave eval dde servername slave} msg] $msg
+} -cleanup {
+ interp delete slave
+} -result {1 {invalid command name "dde"}}
+test winDde-8.2 {Safe DDE set servername} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+} -body {
+ slave invokehidden dde servername slave
+} -cleanup {interp delete slave} -result {slave}
+test winDde-8.3 {Safe DDE check handler required for eval} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave invokehidden dde servername slave
+} -body {
+ catch {dde eval slave set a 1} msg
+} -cleanup {interp delete slave} -result {1}
+test winDde-8.4 {Safe DDE check that execute is denied} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave invokehidden dde servername slave
+} -body {
+ slave eval set a 1
+ list [catch {
+ dde execute TclEval slave {set a 2}
+ slave eval set a
+ } msg] $msg
+} -cleanup {interp delete slave} -result {0 1}
+test winDde-8.5 {Safe DDE check that request is denied} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave invokehidden dde servername slave
+} -body {
+ slave eval set a 1
+ list [catch {dde request TclEval slave a} msg] $msg
+} -cleanup {
+ interp delete slave
+} -result {1 {remote server cannot handle this command}}
+test winDde-8.6 {Safe DDE assign handler procedure} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+} -body {
+ slave invokehidden dde servername -handler DDEACCEPT slave
+} -cleanup {interp delete slave} -result slave
+test winDde-8.7 {Safe DDE check simple command} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+} -body {
+ list [catch {
+ dde eval slave set x 1
+ } msg] $msg
+} -cleanup {interp delete slave} -result {0 {set x 1}}
+test winDde-8.8 {Safe DDE check non-list command} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+} -body {
+ list [catch {
+ set s "c:\\Program Files\\Microsoft Visual Studio\\"
+ dde eval slave $s
+ string compare [slave eval set DDECMD] $s
+ } msg] $msg
+} -cleanup {interp delete slave} -result {0 0}
+test winDde-8.9 {Safe DDE check command evaluation} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+} -body {
+ list [catch {
+ dde eval slave set x 1
+ slave eval set x
+ } msg] $msg
+} -cleanup {interp delete slave} -result {0 1}
+test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+} -body {
+ list [catch {
+ dde eval slave [list set x 1]
+ slave eval set x
+ } msg] $msg
+} -cleanup {interp delete slave} -result {0 1}
+test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {pcOnly dde} -setup {
+ interp create -safe slave
+ slave invokehidden load $lib dde
+ slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
+ slave invokehidden dde servername -handler DDEACCEPT slave
+} -body {
+ list [catch {
+ dde eval slave [list [list set x 1]]
+ slave eval set x
+ } msg] $msg
+} -cleanup {interp delete slave} -result {1 {invalid command name "set x 1"}}
# -------------------------------------------------------------------------
-test winDde-9.1 {External safe DDE check string passing} \
- -constraints {pcOnly stdio} \
- -setup {
- set name child-9.1
- set child [createChildProcess $name Handler1]
- file copy -force script1.tcl dde-script.tcl
- } \
- -body {
- list [catch {
- dde eval $name set x 1
- gets $child line
- set line
- } msg] $msg
- } \
- -cleanup {
- dde execute TclEval $name stop
- update
- file delete -force -- dde-script.tcl
- } \
- -result {0 {set x 1}}
-
-test winDde-9.2 {External safe DDE check command evaluation} \
- -constraints {pcOnly stdio} \
- -setup {
- set name child-9.2
- set child [createChildProcess $name Handler2]
- file copy -force script1.tcl dde-script.tcl
- } \
- -body {
- list [catch {
- dde eval $name set x 1
- gets $child line
- set line
- } msg] $msg
- } \
- -cleanup {
- dde execute TclEval $name stop
- update
- file delete -force -- dde-script.tcl
- } \
- -result {0 1}
-
-test winDde-9.3 {External safe DDE check prefixed arguments} \
- -constraints {pcOnly stdio} \
- -setup {
- set name child-9.3
- set child [createChildProcess $name [list Handler3 ARG]]
- file copy -force script1.tcl dde-script.tcl
- } \
- -body {
- list [catch {
- dde eval $name set x 1
- gets $child line
- set line
- } msg] $msg
- } \
- -cleanup {
- dde execute TclEval $name stop
- update
- file delete -force -- dde-script.tcl
- } \
- -result {0 {ARG {set x 1}}}
+test winDde-9.1 {External safe DDE check string passing} -constraints {pcOnly dde stdio} -setup {
+ set name child-9.1
+ set child [createChildProcess $name Handler1]
+ file copy -force script1.tcl dde-script.tcl
+} -body {
+ list [catch {
+ dde eval $name set x 1
+ gets $child line
+ set line
+ } msg] $msg
+} -cleanup {
+ dde execute TclEval $name stop
+ update
+ file delete -force -- dde-script.tcl
+} -result {0 {set x 1}}
+test winDde-9.2 {External safe DDE check command evaluation} -constraints {pcOnly dde stdio} -setup {
+ set name child-9.2
+ set child [createChildProcess $name Handler2]
+ file copy -force script1.tcl dde-script.tcl
+} -body {
+ list [catch {
+ dde eval $name set x 1
+ gets $child line
+ set line
+ } msg] $msg
+} -cleanup {
+ dde execute TclEval $name stop
+ update
+ file delete -force -- dde-script.tcl
+} -result {0 1}
+test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {pcOnly dde stdio} -setup {
+ set name child-9.3
+ set child [createChildProcess $name [list Handler3 ARG]]
+ file copy -force script1.tcl dde-script.tcl
+} -body {
+ list [catch {
+ dde eval $name set x 1
+ gets $child line
+ set line
+ } msg] $msg
+} -cleanup {
+ dde execute TclEval $name stop
+ update
+ file delete -force -- dde-script.tcl
+} -result {0 {ARG {set x 1}}}
# -------------------------------------------------------------------------
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index d118e27..5da5dd4 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.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: winFCmd.test,v 1.27 2004/05/04 22:30:24 hobbs Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.28 2004/05/19 20:15:32 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -58,9 +58,6 @@ if {[string equal $tcl_platform(platform) "windows"]} {
tcltest::testConstraint winOlderThan2000 0
}
-set ::tcltest::testConstraints(cdrom) 0
-set ::tcltest::testConstraints(exdev) 0
-
# find a CD-ROM so we can test read-only filesystems.
set cdrom {}
@@ -99,25 +96,31 @@ proc findfile {dir} {
}
if {$cdrom != ""} {
- set ::tcltest::testConstraints(cdrom) 1
+ testConstraint cdrom 1
set cdfile [findfile $cdrom]
+} else {
+ testConstraint cdrom 0
}
if {[file exists c:/] && [file exists d:/]} {
catch {file delete d:/tf1}
if {[catch {close [open d:/tf1 w]}] == 0} {
file delete d:/tf1
- set ::tcltest::testConstraints(exdev) 1
+ testConstraint exdev 1
+ } else {
+ testConstraint exdev 0
}
+} else {
+ testConstraint exdev 0
}
file delete -force -- td1
set foo [catch {open td1 w} testfile]
if {$foo} {
- set ::tcltest::testConstraints(longFileNames) 0
+ testConstraint longFileNames 0
} else {
close $testfile
- set ::tcltest::testConstraints(longFileNames) 1
+ testConstraint longFileNames 1
file delete -force -- td1
}
diff --git a/tests/winNotify.test b/tests/winNotify.test
index 3183b27..723866e 100644
--- a/tests/winNotify.test
+++ b/tests/winNotify.test
@@ -10,15 +10,14 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: winNotify.test,v 1.8 2004/05/19 13:29:33 dkf Exp $
+# RCS: @(#) $Id: winNotify.test,v 1.9 2004/05/19 20:15:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-set ::tcltest::testConstraints(testeventloop) \
- [expr {[info commands testeventloop] != {}}]
+testConstraint testeventloop [expr {[info commands testeventloop] != {}}]
# There is no explicit test for InitNotifier or NotifierExitHandler
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 4ed7b08..9229533 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: winPipe.test,v 1.26 2004/02/02 02:36:14 davygrvy Exp $
+# RCS: @(#) $Id: winPipe.test,v 1.27 2004/05/19 20:15:32 dkf Exp $
package require tcltest
namespace import -force ::tcltest::*
@@ -22,12 +22,12 @@ testConstraint exec [llength [info commands exec]]
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
-set ::tcltest::testConstraints(cat32) [file exists $cat32]
+testConstraint cat32 [file exists $cat32]
if {[catch {puts console1 ""}]} {
- set ::tcltest::testConstraints(AllocConsole) 1
+ testConstraint AllocConsole 1
} else {
- set ::tcltest::testConstraints(.console) 1
+ testConstraint .console 1
}
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
@@ -434,7 +434,6 @@ test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {pcOnl
} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
-
# restore old values for env(TMP) and env(TEMP)
if {[catch {set env(TMP) $env_tmp}]} {
generated by cgit v0.12 at 2024-07-01 10:04:39 (GMT)