summaryrefslogtreecommitdiffstats
path: root/library/tcltest
diff options
context:
space:
mode:
authorhobbs <hobbs>2001-08-22 23:55:45 (GMT)
committerhobbs <hobbs>2001-08-22 23:55:45 (GMT)
commit4c4f94f7a768c1752cc7a2a9e853865f41d1d8d2 (patch)
tree629decb63d1c4a39caf45e2cb0d15e3c0b2a5364 /library/tcltest
parent5632c45bbab15511baefd81981c2a5408b4ea11f (diff)
downloadtcl-4c4f94f7a768c1752cc7a2a9e853865f41d1d8d2.zip
tcl-4c4f94f7a768c1752cc7a2a9e853865f41d1d8d2.tar.gz
tcl-4c4f94f7a768c1752cc7a2a9e853865f41d1d8d2.tar.bz2
* library/tcltest/tcltest.tcl: fixed stdio constraint test.
[Patch #454050] (stanton) Simplified unixExecs constriant test.
Diffstat (limited to 'library/tcltest')
-rw-r--r--library/tcltest/tcltest.tcl81
1 files changed, 27 insertions, 54 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index cdeef93..83c584e 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -13,7 +13,7 @@
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
#
-# RCS: @(#) $Id: tcltest.tcl,v 1.31 2001/08/09 01:06:42 dgp Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.32 2001/08/22 23:55:45 hobbs Exp $
# create the "tcltest" namespace for all testing variables and procedures
@@ -1413,7 +1413,7 @@ proc tcltest::initConstraints {} {
}
# Set nonBlockFiles constraint: 1 means this platform supports
- # ting files into nonblocking mode.
+ # setting files into nonblocking mode.
if {[catch {set f [open defs r]}]} {
tcltest::testConstraint nonBlockFiles 1
@@ -1433,14 +1433,10 @@ proc tcltest::initConstraints {} {
# potential problem with select is apparently interfering.
# (Mark Diekhans).
- if {[string equal $tcl_platform(platform) "unix"]} {
- if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
+ tcltest::testConstraint asyncPipeClose 1
+ if {[string equal $tcl_platform(platform) "unix"] \
+ && ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0)} {
tcltest::testConstraint asyncPipeClose 0
- } else {
- tcltest::testConstraint asyncPipeClose 1
- }
- } else {
- tcltest::testConstraint asyncPipeClose 1
}
# Test to see if we have a broken version of sprintf with respect
@@ -1460,53 +1456,30 @@ proc tcltest::initConstraints {} {
}
if {([tcltest::testConstraint unixExecs] == 1) && \
([string equal $tcl_platform(platform) "windows"])} {
- if {[catch {exec cat defs}] == 1} {
- tcltest::testConstraint unixExecs 0
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec echo hello}] == 1)} {
+ set file "_tcl_test_remove_me.txt"
+ if {[catch {
+ set fid [open $file w]
+ puts $fid "hello"
+ close $fid
+ }]} {
tcltest::testConstraint unixExecs 0
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec sh -c echo hello}] == 1)} {
- tcltest::testConstraint unixExecs 0
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec wc defs}] == 1)} {
+ } elseif {
+ [catch {exec cat $file}] ||
+ [catch {exec echo hello}] ||
+ [catch {exec sh -c echo hello}] ||
+ [catch {exec wc $file}] ||
+ [catch {exec sleep 1}] ||
+ [catch {exec echo abc > $file}] ||
+ [catch {exec chmod 644 $file}] ||
+ [catch {exec rm $file}] ||
+ [string equal {} [auto_execok mkdir]] ||
+ [string equal {} [auto_execok fgrep]] ||
+ [string equal {} [auto_execok grep]] ||
+ [string equal {} [auto_execok ps]]
+ } {
tcltest::testConstraint unixExecs 0
}
- if {[tcltest::testConstraint unixExecs] == 1} {
- exec echo hello > removeMe
- if {[catch {exec rm removeMe}] == 1} {
- tcltest::testConstraint unixExecs 0
- }
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec sleep 1}] == 1)} {
- tcltest::testConstraint unixExecs 0
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec fgrep unixExecs defs}] == 1)} {
- tcltest::testConstraint unixExecs 0
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec ps}] == 1)} {
- tcltest::testConstraint unixExecs 0
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec echo abc > removeMe}] == 0) && \
- ([catch {exec chmod 644 removeMe}] == 1) && \
- ([catch {exec rm removeMe}] == 0)} {
- tcltest::testConstraint unixExecs 0
- } else {
- catch {exec rm -f removeMe}
- }
- if {([tcltest::testConstraint unixExecs] == 1) && \
- ([catch {exec mkdir removeMe}] == 1)} {
- tcltest::testConstraint unixExecs 0
- } else {
- catch {exec rm -r removeMe}
- }
+ file delete -force $file
}
# Locate tcltest executable
@@ -1528,7 +1501,7 @@ proc tcltest::initConstraints {} {
}
close $f
- set f [open "|[list $tcltest tmp]" r]
+ set f [open "|[list $tcltest::tcltest tmp]" r]
close $f
tcltest::testConstraint stdio 1