summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog5
-rw-r--r--tests/dstring.test6
-rw-r--r--tests/misc.test5
-rw-r--r--tests/obj.test4
-rw-r--r--tests/reg.test24
-rw-r--r--tests/unixNotfy.test70
6 files changed, 58 insertions, 56 deletions
diff --git a/ChangeLog b/ChangeLog
index c49369e..95ef7f6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-06-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/unixNotfy.test: Modified constraints so that testing with
+ a threaded tclsh (not tcltest) will not hang.
+
2004-06-23 Don Porter <dgp@users.sourceforge.net>
* generic/tclThreadStorage.c: Corrected type casting errors that led
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} \
generated by cgit v0.12 at 2024-11-14 04:35:06 (GMT)