Updated all and defs to work more smoothly with nightly tests.

Check for existence of "testgetplatform" command before calling
it in fCmd.test file--this command is only in tcltest interps.

3 files changed, 41 insertions, 31 deletions

diff --git a/tests/all b/tests/all
index 161ba98..87d4d84 100644
--- a/tests/all
+++ b/tests/all
@@ -2,14 +2,14 @@
 # tests.  Execute it by invoking "source all" when running tclTest
 # in this directory.
 #
-# RCS: @(#) $Id: all,v 1.3 1998/11/19 21:46:59 hershey Exp $
+# RCS: @(#) $Id: all,v 1.4 1998/12/04 04:18:20 hershey Exp $
 
 set TESTS_DIR [file join [pwd] [file dirname [info script]]]
 source [file join $TESTS_DIR defs]
 set currentDir [pwd]
 
 catch {array set flag $argv}
-set requiredSourceFiles [list autoMkindex.tcl remote.tcl]
+set requiredSourceFiles [list autoMkindex.tcl remote.tcl defs]
 
 #
 # Set the TMP_DIR to pwd or the arg of -tmpdir, if given.
@@ -18,12 +18,12 @@ set requiredSourceFiles [list autoMkindex.tcl remote.tcl]
 if {[info exists flag(-tmpdir)]} {
     set TMP_DIR $flag(-tmpdir)
     if {![file exists $TMP_DIR]} {
-	if {[catch {file mkdir $TMP_DIR}]} {
-	    error "could not create directory $TMP_DIR"
+	if {[catch {file mkdir $TMP_DIR} msg]} {
+	    error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$msg"
 	}
 	file mkdir $TMP_DIR
     } elseif {![file isdir $TMP_DIR]} {
-	error "$TMP_DIR already exists but is not a directory"
+	error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$TMP_DIR is not a directory"
     }
     if {[string compare [file pathtype $TMP_DIR] absolute] != 0} {
 	set TMP_DIR [file join [pwd] $TMP_DIR]
@@ -32,7 +32,7 @@ if {[info exists flag(-tmpdir)]} {
 }
 
 #
-# copy the required source files to the current dir.
+# copy each required source file to the current dir (if it's not already there).
 #
 
 if {[string compare $TESTS_DIR [pwd]] != 0} {
@@ -52,13 +52,13 @@ if {$tcl_platform(os) == "Win32s"} {
 
 foreach file [lsort [glob $globPattern]] {
     set tail [file tail $file]
-    if [string match l.*.test $tail] {
-	# This is an SCCS lockfile
+    if {[string match l.*.test $tail]} {
+	# This is an SCCS lockfile; ignore it
 	continue
     }
     puts stdout $tail
-    if [catch {source $file} msg] {
-	puts $msg
+    if {[catch {source $file} msg]} {
+	puts stdout $msg
     }
 }
 
diff --git a/tests/defs b/tests/defs
index 772e30f..21c9458 100644
--- a/tests/defs
+++ b/tests/defs
@@ -5,16 +5,17 @@
 #
 # Copyright (c) 1990-1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: defs,v 1.4 1998/11/02 23:04:13 stanton Exp $
+# RCS: @(#) $Id: defs,v 1.5 1998/12/04 04:18:20 hershey Exp $
 
-if ![info exists VERBOSE] {
+if {![info exists VERBOSE]} {
     set VERBOSE 0
 }
-if ![info exists TESTS] {
+if {![info exists TESTS]} {
     set TESTS {}
 }
 
@@ -113,11 +114,11 @@ if {$tcl_platform(platform) == "windows"} {
 } else {
     set testConfig(pcOnly) 0
 }
-set testConfig(unixOrPc) [expr $testConfig(unixOnly) || $testConfig(pcOnly)]
-set testConfig(macOrPc) [expr $testConfig(macOnly) || $testConfig(pcOnly)]
-set testConfig(macOrUnix) [expr $testConfig(macOnly) || $testConfig(unixOnly)]
-set testConfig(nonPortable)	[expr [file exists doAllTests] || [file exists doAllTe]]
-set testConfig(knownBug) [expr [file exists doBuggyTests] || [file exists doBuggyT]]
+set testConfig(unixOrPc) [expr {$testConfig(unixOnly) || $testConfig(pcOnly)}]
+set testConfig(macOrPc) [expr {$testConfig(macOnly) || $testConfig(pcOnly)}]
+set testConfig(macOrUnix) [expr {$testConfig(macOnly) || $testConfig(unixOnly)}]
+set testConfig(nonPortable)	[expr {[file exists doAllTests] || [file exists doAllTe]}]
+set testConfig(knownBug) [expr {[file exists doBuggyTests] || [file exists doBuggyT]}]
 set testConfig(notIfCompiled) [file exists doAllCompilerTests]
 
 set testConfig(unix)	$testConfig(unixOnly)
@@ -139,7 +140,7 @@ set testConfig(unixCrash) $testConfig(macOrPc)
 if {[catch {set f [open defs r]}]} {
     set testConfig(nonBlockFiles) 1
 } else {
-    if {[expr [catch {fconfigure $f -blocking off}]] == 0} {
+    if {[catch {fconfigure $f -blocking off}] == 0} {
 	set testConfig(nonBlockFiles) 1
     } else {
 	set testConfig(nonBlockFiles) 0
@@ -176,7 +177,7 @@ if {$tcl_platform(platform) == "unix"} {
 set testConfig(eformat) 1
 if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
     set testConfig(eformat) 0
-    puts "(will skip tests that depend on the \"e\" format of floating-point numbers)"
+    puts stdout "(will skip tests that depend on the \"e\" format of floating-point numbers)"
 }
 # Test to see if execed commands such as cat, echo, rm and so forth are
 # present on this machine.
@@ -288,15 +289,18 @@ proc print_verbose {name description constraints script code answer} {
 
 proc test {name description script answer args} {
     global VERBOSE TESTS testConfig
-    if {[string compare $TESTS ""] != 0} then {
+
+    if {[string compare $TESTS ""] != 0} {
 	set ok 0
 	foreach test $TESTS {
-	    if [string match $test $name] then {
+	    if {[string match $test $name]} {
 		set ok 1
 		break
 	    }
         }
-	if !$ok then return
+	if {!$ok} {
+	    return
+	}
     }
     set i [llength $args]
     if {$i == 0} {
@@ -332,7 +336,7 @@ proc test {name description script answer args} {
 	    }
 	}
 	if {$doTest == 0} {
-	    if $VERBOSE then {
+	    if {$VERBOSE} {
 		puts stdout "++++ $name SKIPPED: $constraints"
 	    }
 	    return	
@@ -345,8 +349,8 @@ proc test {name description script answer args} {
     if {$code != 0} {
 	print_verbose $name $description $constraints $script \
 		$code $result
-    } elseif {[string compare $result $answer] == 0} then { 
-	if $VERBOSE then {
+    } elseif {[string compare $result $answer] == 0} { 
+	if {$VERBOSE} {
 	    if {$VERBOSE > 0} {
 		print_verbose $name $description $constraints $script \
 		    $code $result
@@ -382,7 +386,7 @@ proc normalizeMsg {msg} {
 proc makeFile {contents name} {
     set fd [open $name w]
     fconfigure $fd -translation lf
-    if {[string index $contents [expr [string length $contents] - 1]] == "\n"} {
+    if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
 	puts -nonewline $fd $contents
     } else {
 	puts $fd $contents
@@ -421,7 +425,7 @@ set tcltest [info nameofexecutable]
 
 if {$tcltest == "{}"} {
     set tcltest {}
-    puts "Unable to find tcltest executable, multiple process tests will fail."
+    puts stdout "Unable to find tcltest executable, multiple process tests will fail."
 }
 
 if {$tcl_platform(os) != "Win32s"} {
@@ -443,14 +447,14 @@ if {$tcl_platform(os) != "Win32s"} {
 }
 
 if {($tcl_platform(platform) == "windows") && ($testConfig(stdio) == 0)} {
-    puts "(will skip tests that redirect stdio of exec'd 32-bit applications)"
+    puts stdout "(will skip tests that redirect stdio of exec'd 32-bit applications)"
 }
 
 catch {socket} msg
 set testConfig(socket) [expr {$msg != "sockets are not available on this system"}]
 
 if {$testConfig(socket) == 0} {
-    puts "(will skip tests that use sockets)"
+    puts stdout "(will skip tests that use sockets)"
 }
     
         
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 0166643..2af1989 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -9,11 +9,17 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.3 1998/12/04 04:18:20 hershey Exp $
 #
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
+if {[string compare testgetplatform [info commands testgetplatform]] != 0} {
+    puts "This application hasn't been compiled with the \"testgetplatform\""
+    puts "command, therefore I am skipping all of these tests."
+    return
+}
+
 set platform [testgetplatform]
 
 if {$user == "root"} {