Attachment "exec.patch" to
ticket [579378ffff]
added by
dgp
2002-07-10 06:37:09.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1113
diff -u -r1.1113 ChangeLog
--- ChangeLog 8 Jul 2002 22:01:39 -0000 1.1113
+++ ChangeLog 9 Jul 2002 23:33:59 -0000
@@ -1,3 +1,21 @@
+2002-07-09 Don Porter <[email protected]>
+
+ * tests/basic.test: Cleaned up, constrained, and reduced the
+ * tests/compile.test: amount of [exec] usage in the test suite.
+ * tests/encoding.test:
+ * tests/env.test:
+ * tests/event.test:
+ * tests/exec.test:
+ * tests/io.test:
+ * tests/ioCmd.test:
+ * tests/regexp.test:
+ * tests/regexpComp.test:
+ * tests/socket.test:
+ * tests/tcltest.test:
+ * tests/unixInit.test:
+ * tests/winDde.test:
+ * tests/winPipe.test:
+
2002-07-08 Andreas Kupries <[email protected]>
* tests/socket.test: Fixed bug #578164. The original reason for
Index: tests/basic.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/basic.test,v
retrieving revision 1.22
diff -u -r1.22 basic.test
--- tests/basic.test 4 Jul 2002 16:52:07 -0000 1.22
+++ tests/basic.test 9 Jul 2002 23:33:59 -0000
@@ -18,19 +18,13 @@
# RCS: @(#) $Id: basic.test,v 1.22 2002/07/04 16:52:07 msofer Exp $
#
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
-
-::tcltest::testConstraint testcmdtoken \
- [llength [info commands testcmdtoken]]
-::tcltest::testConstraint testcmdtrace \
- [llength [info commands testcmdtrace]]
-::tcltest::testConstraint testcreatecommand \
- [llength [info commands testcreatecommand]]
-::tcltest::testConstraint exec \
- [llength [info commands exec]]
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+testConstraint testcmdtoken [llength [info commands testcmdtoken]]
+testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testcreatecommand [llength [info commands testcreatecommand]]
+testConstraint exec [llength [info commands exec]]
# This variable needs to be changed when the major or minor version number for
# Tcl changes.
@@ -561,10 +555,10 @@
test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} {
} {}
-test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {exec} {
+test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
catch {close $f}
set res [catch {
- set f [open |[list [info nameofexecutable]] w+]
+ set f [open |[list [interpreter]] w+]
fconfigure $f -buffering line
puts $f {fconfigure stdout -buffering line}
puts $f continue
@@ -591,7 +585,7 @@
puts hello
break
} BREAKtest]
- set res [list [catch {exec [info nameofexecutable] $fName} msg] $msg]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
removeFile BREAKtest
regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
set res
@@ -607,7 +601,7 @@
patch
break
} BREAKtest]
- set res [list [catch {exec [info nameofexecutable] $fName} msg] $msg]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
removeFile BREAKtest
regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
set res
@@ -620,7 +614,7 @@
set fName [makeFile {
foo [set a 1] [break]
} BREAKtest]
- set res [list [catch {exec [info nameofexecutable] $fName} msg] $msg]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
removeFile BREAKtest
regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
set res
@@ -635,7 +629,7 @@
set fName [makeFile {
return -code return
} BREAKtest]
- set res [list [catch {exec [info nameofexecutable] $fName} msg] $msg]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
removeFile BREAKtest
regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
set res
Index: tests/compile.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compile.test,v
retrieving revision 1.21
diff -u -r1.21 compile.test
--- tests/compile.test 22 Jun 2002 04:19:47 -0000 1.21
+++ tests/compile.test 9 Jul 2002 23:33:59 -0000
@@ -13,10 +13,8 @@
#
# RCS: @(#) $Id: compile.test,v 1.21 2002/06/22 04:19:47 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.
@@ -265,8 +263,8 @@
# with TCL_MEM_DEBUG
#
# Special test for leak on interp delete [Bug 467523].
-::tcltest::testConstraint execCommandExists [expr {[info commands exec] != ""}]
-::tcltest::testConstraint memDebug [expr {[info commands memory] != ""}]
+::tcltest::testConstraint exec [llength [info commands exec]]
+::tcltest::testConstraint memDebug [llength [info commands memory]]
test compile-12.1 {testing literal leak on interp delete} {memDebug} {
proc getbytes {} {
@@ -288,8 +286,9 @@
set leak [expr {$end - $tmp}]
} 0
# Special test for a memory error in a preliminary fix of [Bug 467523].
-# It requires executing a helpfile
-test compile-12.2 {testing error on literal deletion} {memDebug execCommandExists} {
+# It requires executing a helpfile. Presumably the child process is
+# used because when this test fails, it crashes.
+test compile-12.2 {testing error on literal deletion} {memDebug exec} {
makeFile {
for {set i 0} {$i < 5} {incr i} {
namespace eval bar {}
@@ -298,9 +297,9 @@
puts 0
} source.file
set res [catch {
- exec [info nameofexecutable] source.file
+ exec [interpreter] source.file
}]
- catch {::tcltest::removeFile source.file}
+ catch {removeFile source.file}
set res
} 0
# Test to catch buffer overrun in TclCompileTokens from buf 530320
@@ -314,14 +313,14 @@
# Special test for underestimating the maxStackSize required for a
# compiled command. A failure will cause a segfault in the child
# process.
-test compile-13.1 {testing underestimate of maxStackSize in list cmd} {execCommandExists} {
+test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
set body {set x [list}
for {set i 0} {$i < 3000} {incr i} {
append body " $i"
}
append body {]; puts OK}
regsub BODY {proc crash {} {BODY}; crash} $body script
- list [catch {exec [info nameofexecutable] << $script} msg] $msg
+ list [catch {exec [interpreter] << $script} msg] $msg
} {0 OK}
# cleanup
Index: tests/encoding.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/encoding.test,v
retrieving revision 1.14
diff -u -r1.14 encoding.test
--- tests/encoding.test 1 Jul 2002 07:52:02 -0000 1.14
+++ tests/encoding.test 9 Jul 2002 23:33:59 -0000
@@ -10,10 +10,8 @@
#
# RCS: @(#) $Id: encoding.test,v 1.14 2002/07/01 07:52:02 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
proc toutf {args} {
global x
@@ -25,12 +23,8 @@
}
# Some tests require the testencoding command
-
-::tcltest::testConstraint testencoding \
- [expr {[info commands testencoding] != {}}]
-::tcltest::testConstraint exec \
- [llength [info commands exec]]
-
+testConstraint testencoding [llength [info commands testencoding]]
+testConstraint exec [llength [info commands exec]]
# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested
@@ -382,7 +376,7 @@
gets $f
} iso2022.tcl]
} -body {
- exec $::tcltest::tcltest $file
+ exec [interpreter] $file
} -cleanup {
removeFile iso2022.tcl
} -result {}
@@ -397,12 +391,12 @@
exit
} iso2022.tcl]
} -body {
- viewable [exec $::tcltest::tcltest $file]
+ viewable [exec [interpreter] $file]
} -cleanup {
removeFile iso2022.tcl
} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
-test encoding-24.3 {EscapeFreeProc on open channels} {exec} {
+test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
# Bug #219314 - if we don't free escape encodings correctly on
# channel closure, we go boom
set file [makeFile {
@@ -410,7 +404,7 @@
set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
puts $a
} iso2022.tcl]
- set f [open "|[list $::tcltest::tcltest $file]"]
+ set f [open "|[list [interpreter] $file]"]
fconfigure $f -encoding iso2022-jp
set count [gets $f line]
close $f
Index: tests/env.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/env.test,v
retrieving revision 1.15
diff -u -r1.15 env.test
--- tests/env.test 5 Jul 2002 10:38:42 -0000 1.15
+++ tests/env.test 9 Jul 2002 23:33:59 -0000
@@ -13,10 +13,8 @@
#
# RCS: @(#) $Id: env.test,v 1.15 2002/07/05 10:38:42 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
#
# These tests will run on any platform (and indeed crashed
@@ -58,7 +56,7 @@
# Some tests require the "exec" command.
# Skip them if exec is not defined.
-::tcltest::testConstraint execCommandExists [expr {[info commands exec] != ""}]
+testConstraint exec [llength [info commands exec]]
set printenvScript [makeFile {
proc lrem {listname name} {
@@ -86,9 +84,11 @@
exit
} printenv]
+# [exec] is required here to see the actual environment received
+# by child processes.
proc getenv {} {
global printenvScript tcltest
- catch {exec $::tcltest::tcltest $printenvScript} out
+ catch {exec [interpreter] $printenvScript} out
if {$out == "child process exited abnormally"} {
set out {}
}
@@ -111,30 +111,30 @@
}
}
-test env-2.1 {adding environment variables} {execCommandExists} {
+test env-2.1 {adding environment variables} {exec} {
getenv
} {}
set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {execCommandExists} {
+test env-2.2 {adding environment variables} {exec} {
getenv
} {NAME1=test string}
set env(NAME2) "more"
-test env-2.3 {adding environment variables} {execCommandExists} {
+test env-2.3 {adding environment variables} {exec} {
getenv
} {NAME1=test string
NAME2=more}
set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {execCommandExists} {
+test env-2.4 {adding environment variables} {exec} {
getenv
} {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {execCommandExists} {
+test env-3.1 {changing environment variables} {exec} {
set result [getenv]
unset env(NAME2)
set result
@@ -142,28 +142,28 @@
NAME2=new value
XYZZY=garbage}
-test env-4.1 {unsetting environment variables} {execCommandExists} {
+test env-4.1 {unsetting environment variables} {exec} {
set result [getenv]
unset env(NAME1)
set result
} {NAME1=test string
XYZZY=garbage}
-test env-4.2 {unsetting environment variables} {execCommandExists} {
+test env-4.2 {unsetting environment variables} {exec} {
set result [getenv]
unset env(XYZZY)
set result
} {XYZZY=garbage}
-test env-4.3 {setting international environment variables} {execCommandExists} {
+test env-4.3 {setting international environment variables} {exec} {
set env(\ua7) \ub6
getenv
} "\ua7=\ub6"
-test env-4.4 {changing international environment variables} {execCommandExists} {
+test env-4.4 {changing international environment variables} {exec} {
set env(\ua7) \ua7
getenv
} "\ua7=\ua7"
-test env-4.5 {unsetting international environment variables} {execCommandExists} {
+test env-4.5 {unsetting international environment variables} {exec} {
set env(\ub6) \ua7
unset env(\ua7)
set result [getenv]
Index: tests/event.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/event.test,v
retrieving revision 1.19
diff -u -r1.19 event.test
--- tests/event.test 5 Jul 2002 10:38:42 -0000 1.19
+++ tests/event.test 9 Jul 2002 23:33:59 -0000
@@ -11,17 +11,12 @@
#
# RCS: @(#) $Id: event.test,v 1.19 2002/07/05 10:38:42 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
-::tcltest::testConstraint testfilehandler \
- [expr {[info commands testfilehandler] != {}}]
-::tcltest::testConstraint testexithandler \
- [expr {[info commands testexithandler] != {}}]
-::tcltest::testConstraint testfilewait \
- [expr {[info commands testfilewait] != {}}]
+testConstraint testfilehandler [llength [info commands testfilehandler]]
+testConstraint testexithandler [llength [info commands testexithandler]]
+testConstraint testfilewait [llength [info commands testfilewait]]
test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
testfilehandler close
@@ -286,7 +281,7 @@
vwait a
}
- list [catch {exec [info nameofexecutable] << $script} errMsg] $errMsg
+ list [catch {exec [interpreter] << $script} errMsg] $errMsg
} {1 {hello
while executing
"error hello"
@@ -305,7 +300,7 @@
test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; exit"
flush $child
@@ -318,7 +313,7 @@
}
test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
@@ -331,7 +326,7 @@
even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 4"
puts $child "testexithandler create 16; exit"
@@ -344,7 +339,7 @@
odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 6"
puts $child "testexithandler create 16; exit"
@@ -357,7 +352,7 @@
odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
@@ -368,7 +363,7 @@
}
test event-10.1 {Tcl_Exit procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "exit 3"
list [catch {close $child} msg] $msg [lindex $errorCode 0] \
[lindex $errorCode 2]
Index: tests/exec.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/exec.test,v
retrieving revision 1.12
diff -u -r1.12 exec.test
--- tests/exec.test 4 Jul 2002 15:46:55 -0000 1.12
+++ tests/exec.test 9 Jul 2002 23:33:59 -0000
@@ -13,14 +13,12 @@
#
# RCS: @(#) $Id: exec.test,v 1.12 2002/07/04 15:46:55 andreas_kupries Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
# All tests require the "exec" command.
# Skip them if exec is not defined.
-::tcltest::testConstraint execCommandExists [expr {[info commands exec] != ""}]
+testConstraint exec [llength [info commands exec]]
set path(echo) [makeFile {
puts -nonewline [lindex $argv 0]
@@ -95,46 +93,46 @@
# Basic operations.
-test exec-1.1 {basic exec operation} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) a b c
+test exec-1.1 {basic exec operation} {exec} {
+ exec [interpreter] $path(echo) a b c
} "a b c"
-test exec-1.2 {pipelining} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) a b c d | $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat)
+test exec-1.2 {pipelining} {exec stdio} {
+ exec [interpreter] $path(echo) a b c d | [interpreter] $path(cat) | [interpreter] $path(cat)
} "a b c d"
-test exec-1.3 {pipelining} {execCommandExists stdio} {
- set a [exec $::tcltest::tcltest $path(echo) a b c d | $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(wc)]
+test exec-1.3 {pipelining} {exec stdio} {
+ set a [exec [interpreter] $path(echo) a b c d | [interpreter] $path(cat) | [interpreter] $path(wc)]
list [scan $a "%d %d %d" b c d] $b $c
} {3 1 4}
set arg {12345678901234567890123456789012345678901234567890}
set arg "$arg$arg$arg$arg$arg$arg"
-test exec-1.4 {long command lines} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) $arg
+test exec-1.4 {long command lines} {exec} {
+ exec [interpreter] $path(echo) $arg
} $arg
set arg {}
# I/O redirection: input from Tcl command.
-test exec-2.1 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) << "Sample text"
+test exec-2.1 {redirecting input from immediate source} {exec stdio} {
+ exec [interpreter] $path(cat) << "Sample text"
} {Sample text}
-test exec-2.2 {redirecting input from immediate source} {execCommandExists stdio} {
- exec << "Sample text" $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat)
+test exec-2.2 {redirecting input from immediate source} {exec stdio} {
+ exec << "Sample text" [interpreter] $path(cat) | [interpreter] $path(cat)
} {Sample text}
-test exec-2.3 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) << "Sample text" | $::tcltest::tcltest $path(cat)
+test exec-2.3 {redirecting input from immediate source} {exec stdio} {
+ exec [interpreter] $path(cat) << "Sample text" | [interpreter] $path(cat)
} {Sample text}
-test exec-2.4 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat) << "Sample text"
+test exec-2.4 {redirecting input from immediate source} {exec stdio} {
+ exec [interpreter] $path(cat) | [interpreter] $path(cat) << "Sample text"
} {Sample text}
-test exec-2.5 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) "<<Joined to arrows"
+test exec-2.5 {redirecting input from immediate source} {exec} {
+ exec [interpreter] $path(cat) "<<Joined to arrows"
} {Joined to arrows}
-test exec-2.6 {redirecting input from immediate source, with UTF} {execCommandExists stdio} {
+test exec-2.6 {redirecting input from immediate source, with UTF} {exec} {
# If this fails, it may give back:
# "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
# If it does, this means that the UTF -> external conversion did not
# occur before writing out the temp file.
- exec $::tcltest::tcltest $path(cat) << "\uE9\uE0\uFC\uF1"
+ exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"
} "\uE9\uE0\uFC\uF1"
# I/O redirection: output to file.
@@ -142,125 +140,125 @@
set path(gorp.file) [makeFile {} gorp.file]
removeFile gorp.file
-test exec-3.1 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "Some simple words" > $path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-3.1 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "Some simple words" > $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Some simple words"
-test exec-3.2 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "More simple words" | >$path(gorp.file) $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-3.2 {redirecting output to file} {exec stdio} {
+ exec [interpreter] $path(echo) "More simple words" | >$path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "More simple words"
-test exec-3.3 {redirecting output to file} {execCommandExists stdio} {
- exec > $path(gorp.file) $::tcltest::tcltest $path(echo) "Different simple words" | $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-3.3 {redirecting output to file} {exec stdio} {
+ exec > $path(gorp.file) [interpreter] $path(echo) "Different simple words" | [interpreter] $path(cat) | [interpreter] $path(cat)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Different simple words"
-test exec-3.4 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "Some simple words" >$path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-3.4 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "Some simple words" >$path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Some simple words"
-test exec-3.5 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "First line" >$path(gorp.file)
- exec $::tcltest::tcltest $path(echo) "Second line" >> $path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-3.5 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "First line" >$path(gorp.file)
+ exec [interpreter] $path(echo) "Second line" >> $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "First line\nSecond line"
-test exec-3.6 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "First line" >$path(gorp.file)
- exec $::tcltest::tcltest $path(echo) "Second line" >>$path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-3.6 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "First line" >$path(gorp.file)
+ exec [interpreter] $path(echo) "Second line" >>$path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "First line\nSecond line"
-test exec-3.7 {redirecting output to file} {execCommandExists stdio} {
+test exec-3.7 {redirecting output to file} {exec} {
set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec $::tcltest::tcltest $path(echo) "More text" >@ $f
- exec $::tcltest::tcltest $path(echo) >@$f "Even more"
+ exec [interpreter] $path(echo) "More text" >@ $f
+ exec [interpreter] $path(echo) >@$f "Even more"
puts $f "Line 3"
close $f
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nMore text\nEven more\nLine 3"
# I/O redirection: output and stderr to file.
removeFile gorp.file
-test exec-4.1 {redirecting output and stderr to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "test output" >& $path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-4.1 {redirecting output and stderr to file} {exec} {
+ exec [interpreter] $path(echo) "test output" >& $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "test output"
-test exec-4.2 {redirecting output and stderr to file} {execCommandExists stdio} {
- list [exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" >&$path(gorp.file)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file)]
+test exec-4.2 {redirecting output and stderr to file} {exec} {
+ list [exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" >&$path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)]
} {{} {foo bar}}
-test exec-4.3 {redirecting output and stderr to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "first line" > $path(gorp.file)
- list [exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" >>&$path(gorp.file)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file)]
+test exec-4.3 {redirecting output and stderr to file} {exec} {
+ exec [interpreter] $path(echo) "first line" > $path(gorp.file)
+ list [exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" >>&$path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)]
} "{} {first line\nfoo bar}"
-test exec-4.4 {redirecting output and stderr to file} {execCommandExists stdio} {
+test exec-4.4 {redirecting output and stderr to file} {exec} {
set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec $::tcltest::tcltest $path(echo) "More text" >&@ $f
- exec $::tcltest::tcltest $path(echo) >&@$f "Even more"
+ exec [interpreter] $path(echo) "More text" >&@ $f
+ exec [interpreter] $path(echo) >&@$f "Even more"
puts $f "Line 3"
close $f
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nMore text\nEven more\nLine 3"
-test exec-4.5 {redirecting output and stderr to file} {execCommandExists stdio} {
+test exec-4.5 {redirecting output and stderr to file} {exec} {
set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec >&@ $f $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2"
- exec >&@$f $::tcltest::tcltest $path(sh) -c "$path(echo) xyzzy 1>&2"
+ exec >&@ $f [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2"
+ exec >&@$f [interpreter] $path(sh) -c "$path(echo) xyzzy 1>&2"
puts $f "Line 3"
close $f
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nfoo bar\nxyzzy\nLine 3"
# I/O redirection: input from file.
-if { [set ::tcltest::testConstraints(execCommandExists)] } {
-exec $::tcltest::tcltest $path(echo) "Just a few thoughts" > $path(gorp.file)
+if { [set ::tcltest::testConstraints(exec)] } {
+exec [interpreter] $path(echo) "Just a few thoughts" > $path(gorp.file)
}
-test exec-5.1 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) < $path(gorp.file)
+test exec-5.1 {redirecting input from file} {exec} {
+ exec [interpreter] $path(cat) < $path(gorp.file)
} {Just a few thoughts}
-test exec-5.2 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat) < $path(gorp.file)
+test exec-5.2 {redirecting input from file} {exec stdio} {
+ exec [interpreter] $path(cat) | [interpreter] $path(cat) < $path(gorp.file)
} {Just a few thoughts}
-test exec-5.3 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) < $path(gorp.file) | $::tcltest::tcltest $path(cat)
+test exec-5.3 {redirecting input from file} {exec stdio} {
+ exec [interpreter] $path(cat) < $path(gorp.file) | [interpreter] $path(cat)
} {Just a few thoughts}
-test exec-5.4 {redirecting input from file} {execCommandExists stdio} {
- exec < $path(gorp.file) $::tcltest::tcltest $path(cat) | $::tcltest::tcltest $path(cat)
+test exec-5.4 {redirecting input from file} {exec stdio} {
+ exec < $path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat)
} {Just a few thoughts}
-test exec-5.5 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) <$path(gorp.file)
+test exec-5.5 {redirecting input from file} {exec} {
+ exec [interpreter] $path(cat) <$path(gorp.file)
} {Just a few thoughts}
-test exec-5.6 {redirecting input from file} {execCommandExists stdio} {
+test exec-5.6 {redirecting input from file} {exec} {
set f [open $path(gorp.file) r]
- set result [exec $::tcltest::tcltest $path(cat) <@ $f]
+ set result [exec [interpreter] $path(cat) <@ $f]
close $f
set result
} {Just a few thoughts}
-test exec-5.7 {redirecting input from file} {execCommandExists stdio} {
+test exec-5.7 {redirecting input from file} {exec} {
set f [open $path(gorp.file) r]
- set result [exec <@$f $::tcltest::tcltest $path(cat)]
+ set result [exec <@$f [interpreter] $path(cat)]
close $f
set result
} {Just a few thoughts}
# I/O redirection: standard error through a pipeline.
-test exec-6.1 {redirecting stderr through a pipeline} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar" |& $::tcltest::tcltest $path(cat)
+test exec-6.1 {redirecting stderr through a pipeline} {exec stdio} {
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar" |& [interpreter] $path(cat)
} "foo bar"
-test exec-6.2 {redirecting stderr through a pipeline} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" |& $::tcltest::tcltest $path(cat)
+test exec-6.2 {redirecting stderr through a pipeline} {exec stdio} {
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" |& [interpreter] $path(cat)
} "foo bar"
-test exec-6.3 {redirecting stderr through a pipeline} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" \
- |& $::tcltest::tcltest $path(sh) -c "$path(echo) second msg 1>&2 ; $path(cat)" |& $::tcltest::tcltest $path(cat)
+test exec-6.3 {redirecting stderr through a pipeline} {exec stdio} {
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" \
+ |& [interpreter] $path(sh) -c "$path(echo) second msg 1>&2 ; $path(cat)" |& [interpreter] $path(cat)
} "second msg\nfoo bar"
# I/O redirection: combinations.
@@ -268,12 +266,12 @@
set path(gorp.file2) [makeFile {} gorp.file2]
removeFile gorp.file2
-test exec-7.1 {multiple I/O redirections} {execCommandExists stdio} {
- exec << "command input" > $path(gorp.file2) $::tcltest::tcltest $path(cat) < $path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file2)
+test exec-7.1 {multiple I/O redirections} {exec} {
+ exec << "command input" > $path(gorp.file2) [interpreter] $path(cat) < $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file2)
} {Just a few thoughts}
-test exec-7.2 {multiple I/O redirections} {execCommandExists stdio} {
- exec < $path(gorp.file) << "command input" $::tcltest::tcltest $path(cat)
+test exec-7.2 {multiple I/O redirections} {exec} {
+ exec < $path(gorp.file) << "command input" [interpreter] $path(cat)
} {command input}
# Long input to command and output from command.
@@ -283,158 +281,158 @@
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
-test exec-8.1 {long input and output} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(cat) << $a
+test exec-8.1 {long input and output} {exec} {
+ exec [interpreter] $path(cat) << $a
} $a
# More than 20 arguments to exec.
-test exec-8.2 {long input and output} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
+test exec-8.2 {long input and output} {exec} {
+ exec [interpreter] $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}
# Commands that return errors.
-test exec-9.1 {commands returning errors} {execCommandExists stdio} {
+test exec-9.1 {commands returning errors} {exec} {
set x [catch {exec gorp456} msg]
list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.2 {commands returning errors} {execCommandExists stdio} {
- string tolower [list [catch {exec $::tcltest::tcltest echo foo | foo123} msg] $msg $errorCode]
+test exec-9.2 {commands returning errors} {exec} {
+ string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.3 {commands returning errors} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(sleep) 1 | $::tcltest::tcltest $path(exit) 43 | $::tcltest::tcltest $path(sleep) 1} msg] $msg
+test exec-9.3 {commands returning errors} {exec stdio} {
+ list [catch {exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1} msg] $msg
} {1 {child process exited abnormally}}
-test exec-9.4 {commands returning errors} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(exit) 43 | $::tcltest::tcltest $path(echo) "foo bar"} msg] $msg
+test exec-9.4 {commands returning errors} {exec stdio} {
+ list [catch {exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"} msg] $msg
} {1 {foo bar
child process exited abnormally}}
-test exec-9.5 {commands returning errors} {execCommandExists stdio} {
- list [catch {exec gorp456 | $::tcltest::tcltest echo a b c} msg] [string tolower $msg]
+test exec-9.5 {commands returning errors} {exec stdio} {
+ list [catch {exec gorp456 | [interpreter] echo a b c} msg] [string tolower $msg]
} {1 {couldn't execute "gorp456": no such file or directory}}
-test exec-9.6 {commands returning errors} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(sh) -c "$path(echo) error msg 1>&2"} msg] $msg
+test exec-9.6 {commands returning errors} {exec} {
+ list [catch {exec [interpreter] $path(sh) -c "$path(echo) error msg 1>&2"} msg] $msg
} {1 {error msg}}
-test exec-9.7 {commands returning errors} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(sh) -c "$path(echo) error msg 1>&2" \
- | $::tcltest::tcltest $path(sh) -c "$path(echo) error msg 1>&2"} msg] $msg
+test exec-9.7 {commands returning errors} {exec stdio} {
+ list [catch {exec [interpreter] $path(sh) -c "$path(echo) error msg 1>&2" \
+ | [interpreter] $path(sh) -c "$path(echo) error msg 1>&2"} msg] $msg
} {1 {error msg
error msg}}
set path(err) [makeFile {} err]
-test exec-9.8 {commands returning errors} {execCommandExists stdio} {
+test exec-9.8 {commands returning errors} {exec} {
set f [open $path(err) w]
puts $f {
puts stdout out
puts stderr err
}
close $f
- list [catch {exec $::tcltest::tcltest $path(err)} msg] $msg
+ list [catch {exec [interpreter] $path(err)} msg] $msg
} {1 {out
err}}
# Errors in executing the Tcl command, as opposed to errors in the
# processes that are invoked.
-test exec-10.1 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.1 {errors in exec invocation} {exec} {
list [catch {exec} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-10.2 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.2 {errors in exec invocation} {exec} {
list [catch {exec | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.3 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.3 {errors in exec invocation} {exec} {
list [catch {exec cat |} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.4 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.4 {errors in exec invocation} {exec} {
list [catch {exec cat | | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.5 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.5 {errors in exec invocation} {exec} {
list [catch {exec cat | |& cat} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.6 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.6 {errors in exec invocation} {exec} {
list [catch {exec cat |&} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.7 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.7 {errors in exec invocation} {exec} {
list [catch {exec cat <} msg] $msg
} {1 {can't specify "<" as last word in command}}
-test exec-10.8 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.8 {errors in exec invocation} {exec} {
list [catch {exec cat >} msg] $msg
} {1 {can't specify ">" as last word in command}}
-test exec-10.9 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.9 {errors in exec invocation} {exec} {
list [catch {exec cat <<} msg] $msg
} {1 {can't specify "<<" as last word in command}}
-test exec-10.10 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.10 {errors in exec invocation} {exec} {
list [catch {exec cat >>} msg] $msg
} {1 {can't specify ">>" as last word in command}}
-test exec-10.11 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.11 {errors in exec invocation} {exec} {
list [catch {exec cat >&} msg] $msg
} {1 {can't specify ">&" as last word in command}}
-test exec-10.12 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.12 {errors in exec invocation} {exec} {
list [catch {exec cat >>&} msg] $msg
} {1 {can't specify ">>&" as last word in command}}
-test exec-10.13 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.13 {errors in exec invocation} {exec} {
list [catch {exec cat >@} msg] $msg
} {1 {can't specify ">@" as last word in command}}
-test exec-10.14 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.14 {errors in exec invocation} {exec} {
list [catch {exec cat <@} msg] $msg
} {1 {can't specify "<@" as last word in command}}
-test exec-10.15 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.15 {errors in exec invocation} {exec} {
list [catch {exec cat < a/b/c} msg] [string tolower $msg]
} {1 {couldn't read file "a/b/c": no such file or directory}}
-test exec-10.16 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.16 {errors in exec invocation} {exec} {
list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
-test exec-10.17 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.17 {errors in exec invocation} {exec} {
list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
set f [open $path(gorp.file) w]
-test exec-10.18 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.18 {errors in exec invocation} {exec} {
list [catch {exec cat <@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for reading}"
close $f
set f [open $path(gorp.file) r]
-test exec-10.19 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.19 {errors in exec invocation} {exec} {
list [catch {exec cat >@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for writing}"
close $f
-test exec-10.20 {errors in exec invocation} {execCommandExists stdio} {
+test exec-10.20 {errors in exec invocation} {exec} {
list [catch {exec ~non_existent_user/foo/bar} msg] $msg
} {1 {user "non_existent_user" doesn't exist}}
-test exec-10.21 {errors in exec invocation} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest true | ~xyzzy_bad_user/x | false} msg] $msg
+test exec-10.21 {errors in exec invocation} {exec} {
+ list [catch {exec [interpreter] true | ~xyzzy_bad_user/x | false} msg] $msg
} {1 {user "xyzzy_bad_user" doesn't exist}}
# Commands in background.
-test exec-11.1 {commands in background} {execCommandExists stdio} {
- set x [lindex [time {exec $::tcltest::tcltest $path(sleep) 2 &}] 0]
+test exec-11.1 {commands in background} {exec} {
+ set x [lindex [time {exec [interpreter] $path(sleep) 2 &}] 0]
expr $x<1000000
} 1
-test exec-11.2 {commands in background} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(echo) a &b} msg] $msg
+test exec-11.2 {commands in background} {exec} {
+ list [catch {exec [interpreter] $path(echo) a &b} msg] $msg
} {0 {a &b}}
-test exec-11.3 {commands in background} {execCommandExists stdio} {
- llength [exec $::tcltest::tcltest $path(sleep) 1 &]
+test exec-11.3 {commands in background} {exec} {
+ llength [exec [interpreter] $path(sleep) 1 &]
} 1
-test exec-11.4 {commands in background} {execCommandExists stdio} {
- llength [exec $::tcltest::tcltest $path(sleep) 1 | $::tcltest::tcltest $path(sleep) 1 | $::tcltest::tcltest $path(sleep) 1 &]
+test exec-11.4 {commands in background} {exec stdio} {
+ llength [exec [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 &]
} 3
-test exec-11.5 {commands in background} {execCommandExists stdio} {
+test exec-11.5 {commands in background} {exec} {
set f [open $path(gorp.file) w]
puts $f [format { catch { exec [info nameofexecutable] %s foo & } } $path(echo)]
close $f
- string compare "foo" [exec $::tcltest::tcltest $path(gorp.file)]
+ string compare "foo" [exec [interpreter] $path(gorp.file)]
} 0
# Make sure that background commands are properly reaped when
# they eventually die.
-if { [set ::tcltest::testConstraints(execCommandExists)] } {
-exec $::tcltest::tcltest $path(sleep) 3
+if { [set ::tcltest::testConstraints(exec)] } {
+exec [interpreter] $path(sleep) 3
}
test exec-12.1 {reaping background processes} \
- {execCommandExists stdio unixOnly nonPortable} {
+ {exec unixOnly nonPortable} {
for {set i 0} {$i < 20} {incr i} {
exec echo foo > /dev/null &
}
@@ -443,7 +441,7 @@
lindex $msg 0
} 0
test exec-12.2 {reaping background processes} \
- {execCommandExists stdio unixOnly nonPortable} {
+ {exec unixOnly nonPortable} {
exec sleep 2 | sleep 2 | sleep 2 &
catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
set x [lindex $msg 0]
@@ -452,7 +450,7 @@
list $x [lindex $msg 0]
} {3 0}
test exec-12.3 {reaping background processes} \
- {execCommandExists stdio unixOnly nonPortable} {
+ {exec unixOnly nonPortable} {
exec sleep 1000 &
exec sleep 1000 &
set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
@@ -475,13 +473,13 @@
# Make sure "errorCode" is set correctly.
-test exec-13.1 {setting errorCode variable} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(cat) < a/b/c} msg] [string tolower $errorCode]
+test exec-13.1 {setting errorCode variable} {exec} {
+ list [catch {exec [interpreter] $path(cat) < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.2 {setting errorCode variable} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest $path(cat) > a/b/c} msg] [string tolower $errorCode]
+test exec-13.2 {setting errorCode variable} {exec} {
+ list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.3 {setting errorCode variable} {execCommandExists stdio} {
+test exec-13.3 {setting errorCode variable} {exec} {
set x [catch {exec _weird_cmd_} msg]
list $x [string tolower $msg] [lindex $errorCode 0] \
[string tolower [lrange $errorCode 2 end]]
@@ -489,85 +487,85 @@
# Switches before the first argument
-test exec-14.1 {-keepnewline switch} {execCommandExists stdio} {
- exec -keepnewline $::tcltest::tcltest $path(echo) foo
+test exec-14.1 {-keepnewline switch} {exec} {
+ exec -keepnewline [interpreter] $path(echo) foo
} "foo\n"
-test exec-14.2 {-keepnewline switch} {execCommandExists stdio} {
+test exec-14.2 {-keepnewline switch} {exec} {
list [catch {exec -keepnewline} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-14.3 {unknown switch} {execCommandExists stdio} {
+test exec-14.3 {unknown switch} {exec} {
list [catch {exec -gorp} msg] $msg
} {1 {bad switch "-gorp": must be -keepnewline or --}}
-test exec-14.4 {-- switch} {execCommandExists stdio} {
+test exec-14.4 {-- switch} {exec} {
list [catch {exec -- -gorp} msg] [string tolower $msg]
} {1 {couldn't execute "-gorp": no such file or directory}}
# Redirecting standard error separately from standard output
-test exec-15.1 {standard error redirection} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "First line" > $path(gorp.file)
- list [exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" 2> $path(gorp.file)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file)]
+test exec-15.1 {standard error redirection} {exec} {
+ exec [interpreter] $path(echo) "First line" > $path(gorp.file)
+ list [exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" 2> $path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)]
} {{} {foo bar}}
-test exec-15.2 {standard error redirection} {execCommandExists stdio} {
- list [exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" \
- | $::tcltest::tcltest $path(echo) biz baz >$path(gorp.file) 2> $path(gorp.file2)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file2)]
+test exec-15.2 {standard error redirection} {exec stdio} {
+ list [exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" \
+ | [interpreter] $path(echo) biz baz >$path(gorp.file) 2> $path(gorp.file2)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file2)]
} {{} {biz baz} {foo bar}}
-test exec-15.3 {standard error redirection} {execCommandExists stdio} {
- list [exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" \
- | $::tcltest::tcltest $path(echo) biz baz 2>$path(gorp.file) > $path(gorp.file2)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file)] \
- [exec $::tcltest::tcltest $path(cat) $path(gorp.file2)]
+test exec-15.3 {standard error redirection} {exec stdio} {
+ list [exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" \
+ | [interpreter] $path(echo) biz baz 2>$path(gorp.file) > $path(gorp.file2)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file2)]
} {{} {foo bar} {biz baz}}
-test exec-15.4 {standard error redirection} {execCommandExists stdio} {
+test exec-15.4 {standard error redirection} {exec} {
set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" 2>@ $f
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" 2>@ $f
puts $f "Line 3"
close $f
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} {Line 1
foo bar
Line 3}
-test exec-15.5 {standard error redirection} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(echo) "First line" > $path(gorp.file)
- exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" 2>> $path(gorp.file)
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+test exec-15.5 {standard error redirection} {exec} {
+ exec [interpreter] $path(echo) "First line" > $path(gorp.file)
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" 2>> $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} {First line
foo bar}
-test exec-15.6 {standard error redirection} {execCommandExists stdio} {
- exec $::tcltest::tcltest $path(sh) -c "$path(echo) foo bar 1>&2" > $path(gorp.file2) 2> $path(gorp.file) \
- >& $path(gorp.file) 2> $path(gorp.file2) | $::tcltest::tcltest $path(echo) biz baz
- list [exec $::tcltest::tcltest $path(cat) $path(gorp.file)] [exec $::tcltest::tcltest $path(cat) $path(gorp.file2)]
+test exec-15.6 {standard error redirection} {exec stdio} {
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar 1>&2" > $path(gorp.file2) 2> $path(gorp.file) \
+ >& $path(gorp.file) 2> $path(gorp.file2) | [interpreter] $path(echo) biz baz
+ list [exec [interpreter] $path(cat) $path(gorp.file)] [exec [interpreter] $path(cat) $path(gorp.file2)]
} {{biz baz} {foo bar}}
-test exec-16.1 {flush output before exec} {execCommandExists stdio} {
+test exec-16.1 {flush output before exec} {exec} {
set f [open $path(gorp.file) w]
puts $f "First line"
- exec $::tcltest::tcltest $path(echo) "Second line" >@ $f
+ exec [interpreter] $path(echo) "Second line" >@ $f
puts $f "Third line"
close $f
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} {First line
Second line
Third line}
-test exec-16.2 {flush output before exec} {execCommandExists stdio} {
+test exec-16.2 {flush output before exec} {exec} {
set f [open $path(gorp.file) w]
puts $f "First line"
- exec $::tcltest::tcltest << {puts stderr {Second line}} >&@ $f > $path(gorp.file2)
+ exec [interpreter] << {puts stderr {Second line}} >&@ $f > $path(gorp.file2)
puts $f "Third line"
close $f
- exec $::tcltest::tcltest $path(cat) $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} {First line
Second line
Third line}
set path(script) [makeFile {} script]
-test exec-17.1 { inheriting standard I/O } {execCommandExists stdio} {
+test exec-17.1 { inheriting standard I/O } {exec} {
set f [open $path(script) w]
puts $f [format {close stdout
set f [open %s w]
@@ -576,7 +574,7 @@
close $f
} $path(gorp.file) $path(echo) $path(sleep)]
close $f
- catch {exec $::tcltest::tcltest $path(script)} result
+ catch {exec [interpreter] $path(script)} result
set f [open $path(gorp.file) r]
lappend result [read $f]
close $f
@@ -584,7 +582,7 @@
} {{foobar
}}
-test exec-18.1 { exec cat deals with weird file names} {execCommandExists} {
+test exec-18.1 { exec cat deals with weird file names} {exec} {
set f "foo\[\{blah"
set path(fooblah) [makeFile {} $f]
set fout [open $path(fooblah) w]
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.35
diff -u -r1.35 io.test
--- tests/io.test 4 Jul 2002 15:46:55 -0000 1.35
+++ tests/io.test 9 Jul 2002 23:34:00 -0000
@@ -29,6 +29,7 @@
namespace import ::tcltest::viewFile
testConstraint testchannel [llength [info commands testchannel]]
+testConstraint exec [llength [info commands exec]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -1579,7 +1580,7 @@
set path(test3) [makeFile {} test3]
-test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
+test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
set f [open $path(test1) w]
puts $f [format {
close stdin
@@ -1608,7 +1609,7 @@
} {err
}}
# This test relies on the fact that the smallest available fd is used first.
-test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
+test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unixOnly} {
set f [open $path(test1) w]
puts $f [format { close stdin
close stdout
@@ -2660,7 +2661,7 @@
set result ok
}
} ok
-test io-29.33 {Tcl_Flush, implicit flush on exit} {stdio} {
+test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
set f [open $path(script) w]
puts $f [format {
set f [open "%s" w]
Index: tests/ioCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/ioCmd.test,v
retrieving revision 1.14
diff -u -r1.14 ioCmd.test
--- tests/ioCmd.test 4 Jul 2002 15:46:55 -0000 1.14
+++ tests/ioCmd.test 9 Jul 2002 23:34:00 -0000
@@ -22,8 +22,6 @@
removeFile test1
removeFile pipe
-set executable [list [info nameofexecutable]]
-
test iocmd-1.1 {puts command} {
list [catch {puts} msg] $msg
} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
Index: tests/regexp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/regexp.test,v
retrieving revision 1.21
diff -u -r1.21 regexp.test
--- tests/regexp.test 5 Jul 2002 10:38:43 -0000 1.21
+++ tests/regexp.test 9 Jul 2002 23:34:00 -0000
@@ -433,10 +433,11 @@
regexp -nocase $x bbba
} 1
-# There is no exec on the Mac ...
-
-test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {unixOrPc} {
- exec $::tcltest::tcltest [makeFile {puts [regexp {} foo]} junk.tcl]
+testConstraint exec [llength [info commands exec]]
+test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {
+ exec
+} {
+ exec [interpreter] [makeFile {puts [regexp {} foo]} junk.tcl]
} 1
test regexp-15.1 {regexp -start} {
Index: tests/regexpComp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/regexpComp.test,v
retrieving revision 1.5
diff -u -r1.5 regexpComp.test
--- tests/regexpComp.test 5 Jul 2002 10:38:43 -0000 1.5
+++ tests/regexpComp.test 9 Jul 2002 23:34:00 -0000
@@ -592,10 +592,11 @@
}
} 1
-# There is no exec on the Mac ...
-
-test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {unixOrPc} {
- exec $::tcltest::tcltest [makeFile {puts [regexp {} foo]} junk.tcl]
+testConstraint exec [llength [info commands exec]]
+test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {
+ exec
+} {
+ exec [interpreter] [makeFile {puts [regexp {} foo]} junk.tcl]
} 1
test regexp-15.1 {regexp -start} {
Index: tests/socket.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/socket.test,v
retrieving revision 1.25
diff -u -r1.25 socket.test
--- tests/socket.test 8 Jul 2002 22:01:41 -0000 1.25
+++ tests/socket.test 9 Jul 2002 23:34:00 -0000
@@ -62,18 +62,13 @@
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
# Some tests require the testthread and exec commands
+testConstraint testthread [llength [info commands testthread]]
+testConstraint exec [llength [info commands exec]]
-set ::tcltest::testConstraints(testthread) \
- [expr {[info commands testthread] != {}}]
-set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
-
-#
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
#
@@ -128,7 +123,7 @@
set remoteFile [file join [pwd] [file dirname [info script]] \
remote.tcl]
if {[catch {set remoteProcChan \
- [open "|[list $::tcltest::tcltest $remoteFile \
+ [open "|[list [interpreter] $remoteFile \
-serverIsSilent \
-port $remoteServerPort \
-address $remoteServerIP]" \
@@ -143,7 +138,7 @@
set doTestsWithRemoteServer 0
}
} else {
- set noRemoteTestReason "$msg $::tcltest::tcltest"
+ set noRemoteTestReason "$msg [interpreter]"
set doTestsWithRemoteServer 0
}
}
@@ -269,7 +264,7 @@
puts $x
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
if {[catch {socket 127.0.0.1 $listen} msg]} {
@@ -307,7 +302,7 @@
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
global port
@@ -342,7 +337,7 @@
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
set x $sock
@@ -374,7 +369,7 @@
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
if {[catch {socket 127.0.0.1 $listen} sock]} {
@@ -407,7 +402,7 @@
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
if {[catch {socket 127.0.0.1 $listen} sock]} {
@@ -459,7 +454,7 @@
puts $x
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
set s [socket 127.0.0.1 $listen]
@@ -500,7 +495,7 @@
close $f
puts "done $i"
} script
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
set s [socket 127.0.0.1 $listen]
@@ -522,7 +517,7 @@
set f [open $path(script) w]
puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
after 100
set x [list [catch {close $f} msg]]
@@ -594,7 +589,7 @@
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r+]
+ set f [open "|[list [interpreter] $path(script)]" r+]
gets $f
gets $f listen
set x [list [catch {socket -server accept $listen} msg] \
@@ -638,7 +633,7 @@
puts $x
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r+]
+ set f [open "|[list [interpreter] $path(script)]" r+]
set x [gets $f]
gets $f listen
set s1 [socket 127.0.0.1 $listen]
@@ -679,11 +674,11 @@
gets stdin
}
close $f
- set p1 [open "|[list $::tcltest::tcltest $path(script)]" r+]
+ set p1 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p1 -buffering line
- set p2 [open "|[list $::tcltest::tcltest $path(script)]" r+]
+ set p2 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p2 -buffering line
- set p3 [open "|[list $::tcltest::tcltest $path(script)]" r+]
+ set p3 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p3 -buffering line
proc accept {s a p} {
fconfigure $s -buffering line
@@ -771,7 +766,7 @@
socket 127.0.0.1 $port
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r+]
+ set f [open "|[list [interpreter] $path(script)]" r+]
proc bgerror args {
global x
set x $args
@@ -804,7 +799,7 @@
after cancel $timer
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
set s [socket 127.0.0.1 $listen]
@@ -832,7 +827,7 @@
after cancel $timer
}
close $f
- set f [open "|[list $::tcltest::tcltest $path(script)]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
set s [socket 127.0.0.1 $listen]
@@ -1395,7 +1390,7 @@
set path(script1) [makeFile {} script1]
set path(script2) [makeFile {} script2]
-test socket-12.1 {testing inheritance of server sockets} {socket exec} {
+test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
removeFile script1
removeFile script2
@@ -1414,7 +1409,7 @@
# be closed unless script1 inherited it.
set f [open $path(script2) w]
- puts $f [list set tcltest $::tcltest::tcltest]
+ puts $f [list set tcltest [interpreter]]
puts $f [format {
set f [socket -server accept 0]
puts [lindex [fconfigure $f -sockname] 2]
@@ -1430,8 +1425,8 @@
# Launch script2 and wait 5 seconds
- ### exec $::tcltest::tcltest script2 &
- set p [open "|[list $::tcltest::tcltest $path(script2)]" r]
+ ### exec [interpreter] script2 &
+ set p [open "|[list [interpreter] $path(script2)]" r]
gets $p listen
after 5000 { set ok_to_proceed 1 }
@@ -1451,7 +1446,7 @@
close $p
set x
} {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} {socket exec} {
+test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
removeFile script1
removeFile script2
@@ -1470,7 +1465,7 @@
# client socket, the socket will still be open.
set f [open $path(script2) w]
- puts $f [list set tcltest $::tcltest::tcltest]
+ puts $f [list set tcltest [interpreter]]
puts $f [format {
gets stdin port
set f [socket 127.0.0.1 $port]
@@ -1524,9 +1519,9 @@
after 10000 [list set failed 1]
# Launch the script2 process
- ### exec $::tcltest::tcltest script2 &
+ ### exec [interpreter] script2 &
- set p [open "|[list $::tcltest::tcltest $path(script2)]" w]
+ set p [open "|[list [interpreter] $path(script2)]" w]
puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p
vwait x
@@ -1538,7 +1533,7 @@
close $p
set x
} {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
+test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
removeFile script1
removeFile script2
@@ -1550,7 +1545,7 @@
close $f
set f [open $path(script2) w]
- puts $f [list set tcltest $::tcltest::tcltest]
+ puts $f [list set tcltest [interpreter]]
puts $f [format {
set server [socket -server accept 0]
puts stdout [lindex [fconfigure $server -sockname] 2]
@@ -1567,8 +1562,8 @@
# Launch the script2 process and connect to it. See how long
# the socket stays open
- ## exec $::tcltest::tcltest script2 &
- set p [open "|[list $::tcltest::tcltest $path(script2)]" r]
+ ## exec [interpreter] script2 &
+ set p [open "|[list [interpreter] $path(script2)]" r]
gets $p listen
after 1000 set ok_to_proceed 1
Index: tests/tcltest.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/tcltest.test,v
retrieving revision 1.30
diff -u -r1.30 tcltest.test
--- tests/tcltest.test 3 Jul 2002 19:40:31 -0000 1.30
+++ tests/tcltest.test 9 Jul 2002 23:34:00 -0000
@@ -52,17 +52,19 @@
} test.tcl
cd [temporaryDirectory]
+testConstraint exec [llength [info commands exec]]
# test -help
-test tcltest-1.1 {tcltest -help} {unixOrPc} {
+# Child processes because -help [exit]s.
+test tcltest-1.1 {tcltest -help} {exec} {
set result [catch {exec [interpreter] test.tcl -help} msg]
set result [catch {runCmd $cmd}]
list $result [regexp Usage $msg]
} {1 1}
-test tcltest-1.2 {tcltest -help -something} {unixOrPc} {
+test tcltest-1.2 {tcltest -help -something} {exec} {
set result [catch {exec [interpreter] test.tcl -help -something} msg]
list $result [regexp Usage $msg]
} {1 1}
-test tcltest-1.3 {tcltest -h} {unixOrPc} {
+test tcltest-1.3 {tcltest -h} {exec} {
set result [catch {exec [interpreter] test.tcl -h} msg]
list $result [regexp Usage $msg]
} {1 0}
@@ -280,11 +282,11 @@
-setup {tcltest::InitConstraints} \
-body { lsort [array names ::tcltest::testConstraints] } \
-result [lsort {
- 95 98 asyncPipeClose eformat emptyTest hasIsoLocale interactive knownBug
- mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles nonPortable
- notRoot nt pc pcCrash pcOnly root singleTestInterp socket stdio tempNotMac
- tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs unixOnly unixOrPc
- unixOrWin userInteraction win winCrash winOnly
+ 95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
+ knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
+ nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
+ stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
+ unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly
}]
# Removed this broken test. Its usage of [limitConstraints] was not
Index: tests/unixInit.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/unixInit.test,v
retrieving revision 1.26
diff -u -r1.26 unixInit.test
--- tests/unixInit.test 8 May 2002 06:31:50 -0000 1.26
+++ tests/unixInit.test 9 Jul 2002 23:34:00 -0000
@@ -12,13 +12,10 @@
#
# RCS: @(#) $Id: unixInit.test,v 1.26 2002/05/08 06:31:50 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
-set ::tcltest::testConstraints(notInstalledInTmp) \
- [string match /tmp/lib/* [info library]]
+testConstraint notInstalledInTmp [string match /tmp/lib/* [info library]]
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
unset env(TCL_LIBRARY)
@@ -26,32 +23,20 @@
catch {set oldlang $env(LANG)}
set env(LANG) C
-# Some tests will fail if they are run on a machine that doesn't have
-# this Tcl version installed (as opposed to built) on it.
-if {[catch {
- set f [open "|[list $::tcltest::tcltest]" w+]
- exec kill -PIPE [pid $f]
- close $f
-} msg]} {
- set ::tcltest::testConstraints(installedTcl) 0
-} else {
- set ::tcltest::testConstraints(installedTcl) 1
-}
-
-test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
+test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly stdio} {
set x {}
# Watch out for a race condition here. If tcltest is too slow to start
# then we'll kill it before it has a chance to set up its signal handler.
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
puts $f "puts hi"
flush $f
gets $f
exec kill -PIPE [pid $f]
lappend x [catch {close $f}]
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
puts $f "puts hi"
flush $f
gets $f
@@ -64,11 +49,11 @@
# This test is really a test of code in tclUnixChan.c, but the
# channels are set up as part of initialisation of the interpreter so
# the test seems to me to fit here as well as anywhere else.
-test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly installedTcl} {
+test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly stdio} {
# pipe1 is a connection to a server that reports what port it
# starts on, and delivers a constant string to the first client to
# connect to that port before exiting.
- set pipe1 [open "|[list $::tcltest::tcltest]" r+]
+ set pipe1 [open "|[list [interpreter]]" r+]
puts $pipe1 {
proc accept {channel host port} {
puts $channel {puts [fconfigure stdin -peername]; exit}
@@ -88,7 +73,7 @@
# These orders will tell it to print out the details about the
# socket it is taking instructions from, hopefully identifying it
# as a socket. Which is what this test is all about.
- set pipe2 [open "|[list $::tcltest::tcltest <@$sock]" r]
+ set pipe2 [open "|[list [interpreter] <@$sock]" r]
set result [gets $pipe2]
# Clear any pending data; stops certain kinds of (non-important) errors
@@ -112,7 +97,7 @@
}
} {OK}
-proc getlibpath "{program [list $::tcltest::tcltest]}" {
+proc getlibpath [list [list program [interpreter]]] {
set f [open "|[list $program]" w+]
fconfigure $f -buffering none
puts $f {puts $tcl_libPath; exit}
@@ -123,8 +108,7 @@
# Some tests require the testgetdefenc command
-set ::tcltest::testConstraints(testgetdefenc) \
- [expr {[info commands testgetdefenc] != {}}]
+testConstraint testgetdefenc [llength [info commands testgetdefenc]]
test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \
{unixOnly testgetdefenc} {
@@ -135,19 +119,19 @@
set path
} {slappy}
test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \
- {unixOnly installedTcl} {
+ {unixOnly stdio} {
set path [getlibpath]
set installLib lib/tcl[info tclversion]
set developLib tcl[info patchlevel]/library
- set prefix [file dirname [file dirname $::tcltest::tcltest]]
+ set prefix [file dirname [file dirname [interpreter]]]
set x {}
lappend x [string compare [lindex $path 0] $prefix/$installLib]
lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
set x
} {0 0}
-test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly installedTcl} {
+test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly stdio} {
# ((str != NULL) && (str[0] != '\0'))
set env(TCL_LIBRARY) sparkly
@@ -157,7 +141,7 @@
lindex $path 0
} "sparkly"
test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \
- {unixOnly installedTcl} {
+ {unixOnly stdio} {
# ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
set env(TCL_LIBRARY) /a/b/tcl1.7
@@ -167,7 +151,7 @@
lrange $path 0 1
} [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} \
- {unixOnly installedTcl} {
+ {unixOnly stdio} {
# Child process translates env variable from native encoding.
set env(TCL_LIBRARY) "\xa7"
@@ -182,23 +166,37 @@
# cannot test
} {}
test unixInit-2.6 {TclpInitLibraryPath: executable relative} \
- {unixOnly installedTcl} {
- file delete -force /tmp/sparkly
- file mkdir /tmp/sparkly/bin
- file copy $::tcltest::tcltest /tmp/sparkly/bin/tcltest
-
- file mkdir /tmp/sparkly/lib/tcl[info tclversion]
- close [open /tmp/sparkly/lib/tcl[info tclversion]/init.tcl w]
-
- set x [lrange [getlibpath /tmp/sparkly/bin/tcltest] 0 1]
- file delete -force /tmp/sparkly
+ {unixOnly stdio} {
+ makeDirectory tmp
+ makeDirectory [file join tmp sparkly]
+ makeDirectory [file join tmp sparkly bin]
+ file copy [interpreter] [file join [temporaryDirectory] tmp sparkly \
+ bin tcltest]
+ makeDirectory [file join tmp sparkly lib]
+ makeDirectory [file join tmp sparkly lib tcl[info tclversion]]
+ makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl]
+
+ set x [lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \
+ bin tcltest]] 0 1]
+ removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl]
+ removeDirectory [file join tmp sparkly lib tcl[info tclversion]]
+ removeDirectory [file join tmp sparkly lib]
+ removeDirectory [file join tmp sparkly bin]
+ removeDirectory [file join tmp sparkly]
+ removeDirectory tmp
set x
-} [list /tmp/sparkly/lib/tcl[info tclversion] /tmp/lib/tcl[info tclversion]]
+} [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
{emptyTest unixOnly} {
# would need test command to get defaultLibDir and compare it to
# [lindex $auto_path end]
} {}
+#
+# The following two tests write to the directory /tmp/sparkly instead
+# of to [temporaryDirectory]. This is because the failures tested by
+# these tests need paths near the "root" of the file system to present
+# themselves.
+#
test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly notInstalledInTmp} {
# Checking for Bug 219416
# When a program that embeds the Tcl library, like tcltest, is
@@ -218,7 +216,7 @@
file delete -force /tmp/sparkly
file delete -force /tmp/lib/tcl[info tclversion]
file mkdir /tmp/sparkly
- file copy $::tcltest::tcltest /tmp/sparkly/tcltest
+ file copy [interpreter] /tmp/sparkly/tcltest
# Keep any existing /tmp/lib directory
set deletelib 1
@@ -254,7 +252,7 @@
file delete -force /tmp/sparkly
file delete -force /tmp/library
file mkdir /tmp/sparkly
- file copy $::tcltest::tcltest /tmp/sparkly/tcltest
+ file copy [interpreter] /tmp/sparkly/tcltest
file mkdir /tmp/library/
close [open /tmp/library/init.tcl w]
@@ -266,10 +264,10 @@
set x
} [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
/tmp/library /library /tcl[info patchlevel]/library]
-test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
+test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly stdio} {
set env(LANG) C
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
@@ -278,12 +276,12 @@
set enc
} {iso8859-1}
-test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} {
+test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly stdio} {
set env(LANG) japanese
catch {set oldlc_all $env(LC_ALL)}
set env(LC_ALL) japanese
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
Index: tests/winDde.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/winDde.test,v
retrieving revision 1.11
diff -u -r1.11 winDde.test
--- tests/winDde.test 22 Aug 2001 23:56:14 -0000 1.11
+++ tests/winDde.test 9 Jul 2002 23:34:00 -0000
@@ -59,7 +59,7 @@
}
close $f
- set f [open |[list $tcltest::tcltest $::scriptName] r]
+ set f [open |[list [interpreter] $::scriptName] r]
gets $f
return $f
}
@@ -112,7 +112,7 @@
dde request -binary TclEval self a
} "foo\x00"
-test winDde-4.1 {DDE execute remotely} {pcOnly} {
+test winDde-4.1 {DDE execute remotely} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
dde execute TclEval child {set a "foo"}
@@ -121,7 +121,7 @@
set a
} ""
-test winDde-4.2 {DDE execute remotely} {pcOnly} {
+test winDde-4.2 {DDE execute remotely} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
dde execute -async TclEval child {set a "foo"}
@@ -130,7 +130,7 @@
set a
} ""
-test winDde-4.3 {DDE request locally} {pcOnly} {
+test winDde-4.3 {DDE request locally} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
dde execute TclEval child {set a "foo"}
@@ -140,7 +140,7 @@
set a
} foo
-test winDde-4.4 {DDE eval locally} {pcOnly} {
+test winDde-4.4 {DDE eval locally} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
set a [dde eval child set a "foo"]
Index: tests/winPipe.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/winPipe.test,v
retrieving revision 1.18
diff -u -r1.18 winPipe.test
--- tests/winPipe.test 4 Jul 2002 20:26:08 -0000 1.18
+++ tests/winPipe.test 9 Jul 2002 23:34:01 -0000
@@ -14,10 +14,10 @@
#
# RCS: @(#) $Id: winPipe.test,v 1.18 2002/07/04 20:26:08 andreas_kupries Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import -force ::tcltest::*
+
+testConstraint exec [llength [info commands exec]]
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
@@ -64,90 +64,90 @@
set path(stdout) [makeFile {} stdout]
set path(stderr) [makeFile {} stderr]
-test winpipe-1.1 {32 bit comprehensive tests: from little file} {pcOnly stdio cat32} {
+test winpipe-1.1 {32 bit comprehensive tests: from little file} {pcOnly exec cat32} {
exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
-test winpipe-1.2 {32 bit comprehensive tests: from big file} {pcOnly stdio cat32} {
+test winpipe-1.2 {32 bit comprehensive tests: from big file} {pcOnly exec cat32} {
exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt stdio cat32} {
- exec $::tcltest::tcltest more < little | $cat32 > $path(stdout) 2> $path(stderr)
+test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt exec cat32} {
+ exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
-test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {nt stdio cat32} {
- exec $::tcltest::tcltest more < big | $cat32 > $path(stdout) 2> $path(stderr)
+test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {nt exec cat32} {
+ exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {95 stdio cat32} {
+test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {95 exec cat32} {
exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
- {pcOnly stdio cat32 AllocConsole} {
+ {pcOnly cat32 AllocConsole} {
# would block waiting for human input
} {}
-test winpipe-1.7 {32 bit comprehensive tests: from NUL} {pcOnly stdio cat32} {
+test winpipe-1.7 {32 bit comprehensive tests: from NUL} {pcOnly exec cat32} {
exec $cat32 < nul > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {{} stderr32}
-test winpipe-1.8 {32 bit comprehensive tests: from socket} {pcOnly stdio cat32} {
+test winpipe-1.8 {32 bit comprehensive tests: from socket} {pcOnly cat32} {
# doesn't work
} {}
test winpipe-1.9 {32 bit comprehensive tests: from nowhere} \
- {pcOnly stdio cat32 .console} {
+ {pcOnly exec cat32 .console} {
exec $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {{} stderr32}
test winpipe-1.10 {32 bit comprehensive tests: from file handle} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
set f [open $path(little) r]
exec $cat32 <@$f > $path(stdout) 2> $path(stderr)
close $f
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.11 {32 bit comprehensive tests: read from application} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
set f [open "|[list $cat32] < $path(little)" r]
gets $f line
catch {close $f} msg
list $line $msg
} {little stderr32}
test winpipe-1.12 {32 bit comprehensive tests: a little to file} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.13 {32 bit comprehensive tests: a lot to file} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.14 {32 bit comprehensive tests: a little to pipe} \
- {pcOnly stdio cat32} {
- exec $cat32 < $path(little) | $::tcltest::tcltest $path(more) > $path(stdout) 2> $path(stderr)
+ {pcOnly exec stdio cat32} {
+ exec $cat32 < $path(little) | [interpreter] $path(more) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.15 {32 bit comprehensive tests: a lot to pipe} \
- {pcOnly stdio cat32} {
- exec $cat32 < $path(big) | $::tcltest::tcltest $path(more) > $path(stdout) 2> $path(stderr)
+ {pcOnly exec stdio cat32} {
+ exec $cat32 < $path(big) | [interpreter] $path(more) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.16 {32 bit comprehensive tests: to console} {pcOnly stdio cat32} {
+test winpipe-1.16 {32 bit comprehensive tests: to console} {pcOnly exec cat32} {
catch {exec $cat32 << "You should see this\n" >@stdout} msg
set msg
} stderr32
-test winpipe-1.17 {32 bit comprehensive tests: to NUL} {pcOnly stdio cat32} {
+test winpipe-1.17 {32 bit comprehensive tests: to NUL} {pcOnly exec cat32} {
# some apps hang when sending a large amount to NUL. $cat32 isn't one.
catch {exec $cat32 < $path(big) > nul} msg
set msg
} stderr32
test winpipe-1.18 {32 bit comprehensive tests: to nowhere} \
- {pcOnly stdio cat32 .console} {
+ {pcOnly exec cat32 .console} {
exec $cat32 < $path(big) >&@stdout
} {}
-test winpipe-1.19 {32 bit comprehensive tests: to file handle} {pcOnly stdio cat32} {
+test winpipe-1.19 {32 bit comprehensive tests: to file handle} {pcOnly exec cat32} {
set f1 [open $path(stdout) w]
set f2 [open $path(stderr) w]
exec $cat32 < $path(little) >@$f1 2>@$f2
@@ -156,14 +156,14 @@
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.20 {32 bit comprehensive tests: write to application} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
set f [open |[list $cat32 >$path(stdout)] w]
puts -nonewline $f "foo"
catch {close $f} msg
list [contents $path(stdout)] $msg
} {foo stderr32}
test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
set f [open "|[list $cat32]" r+]
puts $f $big
puts $f \032
@@ -172,13 +172,13 @@
catch {close $f}
set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-1.22 {Checking command.com for Win95/98 hanging} {95 stdio} {
+test winpipe-1.22 {Checking command.com for Win95/98 hanging} {95 exec} {
exec command.com /c dir /b
set result 1
} 1
file delete more
-test winpipe-4.1 {Tcl_WaitPid} {nt stdio cat32} {
+test winpipe-4.1 {Tcl_WaitPid} {nt exec cat32} {
proc readResults {f} {
global x result
if { [eof $f] } {
@@ -208,10 +208,10 @@
set env(TMP) c:/
set env(TEMP) c:/
-test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {pcOnly stdio} {
+test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {pcOnly exec} {
set x {}
set existing [glob -nocomplain c:/tcl*.tmp]
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
foreach p [glob -nocomplain c:/tcl*.tmp] {
if {[lsearch $existing $p] == -1} {
lappend x $p
@@ -219,38 +219,38 @@
}
set x
} {}
-test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {pcOnly stdio} {
+test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {pcOnly exec} {
set tmp $env(TMP)
set temp $env(TEMP)
unset env(TMP)
unset env(TEMP)
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
} {}
test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
- {pcOnly stdio} {
+ {pcOnly exec } {
set tmp $env(TMP)
set env(TMP) snarky
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
set env(TMP) $tmp
set x {}
} {}
test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
- {pcOnly stdio} {
+ {pcOnly exec} {
set tmp $env(TMP)
set temp $env(TEMP)
unset env(TMP)
set env(TEMP) snarky
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
} {}
test winpipe-6.1 {PipeSetupProc & PipeCheckProc: read threads} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
set f [open "|[list $cat32]" r+]
fconfigure $f -blocking 0
fileevent $f writable { set x writable }
@@ -270,7 +270,7 @@
} {writable timeout readable {foobar
} timeout 1 stderr32}
test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
- {pcOnly stdio cat32} {
+ {pcOnly exec cat32} {
set f [open "|[list $cat32]" r+]
fconfigure $f -blocking 0
fileevent $f writable { set x writable }
@@ -287,11 +287,11 @@
puts "[list $argv0 $argv]"
} echoArgs.tcl]
-test winpipe-7.1 {BuildCommandLine: null arguments} {pcOnly stdio} {
- exec $::tcltest::tcltest $path(echoArgs.tcl) foo "" bar
+test winpipe-7.1 {BuildCommandLine: null arguments} {pcOnly exec} {
+ exec [interprter] $path(echoArgs.tcl) foo "" bar
} [list $path(echoArgs.tcl) {foo {} bar}]
-test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly stdio} {
- exec $::tcltest::tcltest $path(echoArgs.tcl) foo \" bar
+test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly exec} {
+ exec [interprter] $path(echoArgs.tcl) foo \" bar
} [list $path(echoArgs.tcl) {foo {"} bar}]
# restore old values for env(TMP) and env(TEMP)
