Fix constraints so can test with tclsh as well as tcltest [Bug 736431]

5 files changed, 53 insertions, 56 deletions

diff --git a/tests/dstring.test b/tests/dstring.test
index 6db6429..033e29e 100644
--- a/tests/dstring.test
+++ b/tests/dstring.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: dstring.test,v 1.7 2004/05/19 12:08:07 dkf Exp $
+# RCS: @(#) $Id: dstring.test,v 1.8 2004/06/24 10:34:12 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -323,6 +323,8 @@ test dstring-6.5 {Tcl_DStringGetResult} testdstring {
 } {{} {This is a specially-allocated stringz}}
 
 # cleanup
-testdstring free
+if {[testConstraint testdstring]} {
+    testdstring free
+}
 ::tcltest::cleanupTests
 return
diff --git a/tests/misc.test b/tests/misc.test
index 69b08e1..7eb023d 100644
--- a/tests/misc.test
+++ b/tests/misc.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: misc.test,v 1.7 2003/11/14 23:21:02 dkf Exp $
+# RCS: @(#) $Id: misc.test,v 1.8 2004/06/24 10:34:12 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -67,7 +67,8 @@ missing close-brace for variable name
 "tstProc"}]
 
 for {set i 1} {$i<300} {incr i} {
-    test misc-2.$i {hash table with sys-alloc} "testhashsystemhash $i" OK
+    test misc-2.$i {hash table with sys-alloc} testhashsystemhash \
+	    "testhashsystemhash $i" OK
 }
 
 # cleanup
diff --git a/tests/obj.test b/tests/obj.test
index da7ee7d..c802fb0 100644
--- a/tests/obj.test
+++ b/tests/obj.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: obj.test,v 1.9 2004/06/18 15:06:43 dkf Exp $
+# RCS: @(#) $Id: obj.test,v 1.10 2004/06/24 10:34:12 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -45,7 +45,7 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes
 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} {
+test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
     set result ""
     lappend result [testobj freeallvars]
     lappend result [testintobj set 1 12]
diff --git a/tests/reg.test b/tests/reg.test
index 5b08112..5b66341 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -9,7 +9,7 @@
 #
 # Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 #
-# RCS: @(#) $Id: reg.test,v 1.20 2003/11/17 17:48:17 dgp Exp $
+# RCS: @(#) $Id: reg.test,v 1.21 2004/06/24 10:34:12 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -995,7 +995,7 @@ test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} {
     # Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!!
 } {1 2 2 {}}
 
-test reg-32.1 {canmatch functionality -- at end} {
+test reg-32.1 {canmatch functionality -- at end} testregexp {
     set pat {blah}
     set line "asd asd"
     # can match at the final d, if '%' follows
@@ -1003,7 +1003,7 @@ test reg-32.1 {canmatch functionality -- at end} {
     lappend res $resvar
 } {0 7}
 
-test reg-32.2 {canmatch functionality -- at end} {
+test reg-32.2 {canmatch functionality -- at end} testregexp {
     set pat {s%$}
     set line "asd asd"
     # can only match after the end of the string
@@ -1011,7 +1011,7 @@ test reg-32.2 {canmatch functionality -- at end} {
     lappend res $resvar
 } {0 7}
 
-test reg-32.3 {canmatch functionality -- not last char} {
+test reg-32.3 {canmatch functionality -- not last char} testregexp {
     set pat {[^d]%$}
     set line "asd asd"
     # can only match after the end of the string
@@ -1019,7 +1019,7 @@ test reg-32.3 {canmatch functionality -- not last char} {
     lappend res $resvar
 } {0 7}
 
-test reg-32.3.1 {canmatch functionality -- no match} {
+test reg-32.3.1 {canmatch functionality -- no match} testregexp {
     set pat {\Zx}
     set line "asd asd"
     # can match the last char, if followed by x
@@ -1027,7 +1027,7 @@ test reg-32.3.1 {canmatch functionality -- no match} {
     lappend res $resvar
 } {0 -1}
 
-test reg-32.4 {canmatch functionality -- last char} {knownBug} {
+test reg-32.4 {canmatch functionality -- last char} {knownBug testregexp} {
     set pat {.x}
     set line "asd asd"
     # can match the last char, if followed by x
@@ -1035,7 +1035,7 @@ test reg-32.4 {canmatch functionality -- last char} {knownBug} {
     lappend res $resvar
 } {0 6}
 
-test reg-32.4.1 {canmatch functionality -- last char} {knownBug} {
+test reg-32.4.1 {canmatch functionality -- last char} {knownBug testregexp} {
     set pat {.x$}
     set line "asd asd"
     # can match the last char, if followed by x
@@ -1043,7 +1043,7 @@ test reg-32.4.1 {canmatch functionality -- last char} {knownBug} {
     lappend res $resvar
 } {0 6}
 
-test reg-32.5 {canmatch functionality -- last char} {knownBug} {
+test reg-32.5 {canmatch functionality -- last char} {knownBug testregexp} {
     set pat {.[^d]x$}
     set line "asd asd"
     # can match the last char, if followed by not-d and x.
@@ -1051,7 +1051,7 @@ test reg-32.5 {canmatch functionality -- last char} {knownBug} {
     lappend res $resvar
 } {0 6}
 
-test reg-32.6 {canmatch functionality -- last char} {knownBug} {
+test reg-32.6 {canmatch functionality -- last char} {knownBug testregexp} {
     set pat {[^a]%[^\r\n]*$}
     set line "asd asd"
     # can match at the final d, if '%' follows
@@ -1059,7 +1059,7 @@ test reg-32.6 {canmatch functionality -- last char} {knownBug} {
     lappend res $resvar
 } {0 6}
 
-test reg-32.7 {canmatch functionality -- last char} {knownBug} {
+test reg-32.7 {canmatch functionality -- last char} {knownBug testregexp} {
     set pat {[^a]%$}
     set line "asd asd"
     # can match at the final d, if '%' follows
@@ -1067,7 +1067,7 @@ test reg-32.7 {canmatch functionality -- last char} {knownBug} {
     lappend res $resvar
 } {0 6}
 
-test reg-32.8 {canmatch functionality -- last char} {knownBug} {
+test reg-32.8 {canmatch functionality -- last char} {knownBug testregexp} {
     set pat {[^x]%$}
     set line "asd asd"
     # can match at the final d, if '%' follows
@@ -1075,7 +1075,7 @@ test reg-32.8 {canmatch functionality -- last char} {knownBug} {
     lappend res $resvar
 } {0 6}
 
-test reg-32.9 {canmatch functionality -- more complex case} {knownBug} {
+test reg-32.9 {canmatch functionality -- more complex case} {knownBug testregexp} {
     set pat {((\B\B|\Bh+line)[ \t]*|[^\B]%[^\r\n]*)$}
     set line "asd asd"
     # can match at the final d, if '%' follows
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index b8f8e95..fc9cdde 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.16 2004/06/23 15:36:58 dkf Exp $
+# RCS: @(#) $Id: unixNotfy.test,v 1.17 2004/06/24 10:34:12 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
@@ -24,47 +24,41 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 # When run in a Tk shell, these tests hang.
 testConstraint noTk       [expr {![info exists tk_version]}]
 testConstraint testthread [expr {[info commands testthread] != {}}]
+testConstraint unthreaded [expr {
+    ![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)
+}]
 
 # 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 {noTk && unix && !testthread} \
-    -body {
-	catch {vwait x}
-	set f [open [makeFile "" foo] w]
-	fileevent $f writable {set x 1}
-	vwait x
-	close $f
-	list [catch {vwait x} msg] $msg
-    } \
-    -result {1 {can't wait for variable "x":  would wait forever}} \
-    -cleanup { 
-	catch { close $f }
-	catch { removeFile foo }
-    }
-test unixNotfy-1.2 {Tcl_DeleteFileHandler} \
-    -constraints {noTk && unix && !testthread} \
-    -body {
-	catch {vwait x}
-	set f1 [open [makeFile "" foo] w]
-	set f2 [open [makeFile "" foo2] w]
-	fileevent $f1 writable {set x 1}
-	fileevent $f2 writable {set y 1}
-	vwait x
-	close $f1
-	vwait y
-	close $f2
-	list [catch {vwait x} msg] $msg
-    } \
-    -result {1 {can't wait for variable "x":  would wait forever}} \
-    -cleanup {
-	catch { close $f1 }
-	catch { close $f2 }
-	catch { removeFile foo }
-	catch { removeFile foo2 }
-    }
+test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
+    catch {vwait x}
+    set f [open [makeFile "" foo] w]
+    fileevent $f writable {set x 1}
+    vwait x
+    close $f
+    list [catch {vwait x} msg] $msg
+} -result {1 {can't wait for variable "x":  would wait forever}} -cleanup { 
+    catch { close $f }
+    catch { removeFile foo }
+}
+test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
+    catch {vwait x}
+    set f1 [open [makeFile "" foo] w]
+    set f2 [open [makeFile "" foo2] w]
+    fileevent $f1 writable {set x 1}
+    fileevent $f2 writable {set y 1}
+    vwait x
+    close $f1
+    vwait y
+    close $f2
+    list [catch {vwait x} msg] $msg
+} -result {1 {can't wait for variable "x":  would wait forever}} -cleanup {
+    catch { close $f1 }
+    catch { close $f2 }
+    catch { removeFile foo }
+    catch { removeFile foo2 }
+}
 
 test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
     -constraints {noTk unix testthread} \