From 5e7d6ef8fae9debf78ec144defd6c447fef59192 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 24 Jun 2004 10:34:11 +0000 Subject: Fix constraints so can test with tclsh as well as tcltest [Bug 736431] --- ChangeLog | 5 ++++ tests/dstring.test | 6 +++-- tests/misc.test | 5 ++-- tests/obj.test | 4 +-- tests/reg.test | 24 +++++++++--------- tests/unixNotfy.test | 70 ++++++++++++++++++++++++---------------------------- 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 + + * tests/unixNotfy.test: Modified constraints so that testing with + a threaded tclsh (not tcltest) will not hang. + 2004-06-23 Don Porter * 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} \ -- cgit v0.12