From cbff5b9a590af5d06e6e9158c3119017db2aee7e Mon Sep 17 00:00:00 2001 From: hershey Date: Fri, 4 Dec 1998 04:18:20 +0000 Subject: 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. --- tests/all | 20 ++++++++++---------- tests/defs | 44 ++++++++++++++++++++++++-------------------- tests/fCmd.test | 8 +++++++- 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"} { -- cgit v0.12