From 099b6e9e41a346098526d7088680732358fa2e72 Mon Sep 17 00:00:00 2001 From: stanton Date: Mon, 2 Nov 1998 23:04:13 +0000 Subject: cleaned up test suite so most of the tests pass on Windows --- tests/defs | 10 +++++++++- tests/expr-old.test | 4 ++-- tests/format.test | 40 ++++++++++++++++++++-------------------- tests/interp.test | 5 ++++- tests/io.test | 8 ++++---- tests/registry.test | 7 +++++-- tests/safe.test | 4 ++-- tests/scan.test | 4 ++-- tests/util.test | 4 ++-- tests/winPipe.test | 9 +++++---- win/makefile.vc | 6 ++++-- 11 files changed, 59 insertions(+), 42 deletions(-) diff --git a/tests/defs b/tests/defs index 28f028e..772e30f 100644 --- a/tests/defs +++ b/tests/defs @@ -9,7 +9,7 @@ # 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.3 1998/09/14 18:40:08 stanton Exp $ +# RCS: @(#) $Id: defs,v 1.4 1998/11/02 23:04:13 stanton Exp $ if ![info exists VERBOSE] { set VERBOSE 0 @@ -170,6 +170,14 @@ if {$tcl_platform(platform) == "unix"} { set testConfig(asyncPipeClose) 1 } +# Test to see if we have a broken version of sprintf with respect to the +# "e" format of floating-point numbers. + +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)" +} # Test to see if execed commands such as cat, echo, rm and so forth are # present on this machine. diff --git a/tests/expr-old.test b/tests/expr-old.test index 1ef6afc..0e50a06 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr-old.test,v 1.3 1998/09/14 18:40:09 stanton Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.4 1998/11/02 23:04:13 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -402,7 +402,7 @@ test expr-old-25.15 {type conversions} {expr {24.1 > "24.1a"}} 0 test expr-old-25.16 {type conversions} {expr 2+2.5} 4.5 test expr-old-25.17 {type conversions} {expr 2+2.5} 4.5 test expr-old-25.18 {type conversions} {expr 2.0e2} 200.0 -test expr-old-25.19 {type conversions} {expr 2.0e15} 2e+15 +test expr-old-25.19 {type conversions} {eformat} {expr 2.0e15} 2e+15 test expr-old-25.20 {type conversions} {expr 10.0} 10.0 # Various error conditions. diff --git a/tests/format.test b/tests/format.test index 2cb4436..e3d8be0 100644 --- a/tests/format.test +++ b/tests/format.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: format.test,v 1.2 1998/09/14 18:40:09 stanton Exp $ +# RCS: @(#) $Id: format.test,v 1.3 1998/11/02 23:04:13 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -79,20 +79,20 @@ test format-2.4 {string formatting} { format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x } {abcd This is a very long test string. % x x} -test format-3.1 {e and f formats} { +test format-3.1 {e and f formats} {eformat} { format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053 } {3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04} -test format-3.2 {e and f formats} { +test format-3.2 {e and f formats} {eformat} { format "%20e %20e %20e %20e" 34.2e12 68.514 -.125 -16000. .000053 } { 3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04} if {!$roundOffBug} { - test format-3.3 {e and f formats} { + test format-3.3 {e and f formats} {eformat} { format "%.1e %.1e %.1e %.1e" 34.2e12 68.514 -.126 -16000. .000053 } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04} - test format-3.4 {e and f formats} { + test format-3.4 {e and f formats} {eformat} { format "%020e %020e %020e %020e" 34.2e12 68.514 -.126 -16000. .000053 } {000000003.420000e+13 000000006.851400e+01 -00000001.260000e-01 -00000001.600000e+04} - test format-3.5 {e and f formats} { + test format-3.5 {e and f formats} {eformat} { format "%7.1e %7.1e %7.1e %7.1e" 34.2e12 68.514 -.126 -16000. .000053 } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04} test format-3.6 {e and f formats} { @@ -102,7 +102,7 @@ if {!$roundOffBug} { test format-3.7 {e and f formats} {nonPortable} { format "%.4f %.4f %.4f %.4f %.4f" 34.2e12 68.514 -.125 -16000. .000053 } {34200000000000.0000 68.5140 -0.1250 -16000.0000 0.0001} -test format-3.8 {e and f formats} { +test format-3.8 {e and f formats} {eformat} { format "%.4e %.5e %.6e" -9.99996 -9.99996 9.99996 } {-1.0000e+01 -9.99996e+00 9.999960e+00} test format-3.9 {e and f formats} { @@ -114,7 +114,7 @@ test format-3.10 {e and f formats} { test format-3.11 {e and f formats} { format "%-020f %020f" -9.99996 -9.99996 9.99996 } {-9.999960 -000000000009.999960} -test format-3.12 {e and f formats} { +test format-3.12 {e and f formats} {eformat} { format "%.0e %#.0e" -9.99996 -9.99996 9.99996 } {-1e+01 -1.e+01} test format-3.13 {e and f formats} { @@ -130,10 +130,10 @@ test format-3.16 {e and f formats} { format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001 } {0.0 0.1 0.0 0.0} -test format-4.1 {g-format} { +test format-4.1 {g-format} {eformat} { format "%.3g" 12341.0 } {1.23e+04} -test format-4.2 {g-format} { +test format-4.2 {g-format} {eformat} { format "%.3G" 1234.12345 } {1.23E+03} test format-4.3 {g-format} { @@ -160,10 +160,10 @@ test format-4.9 {g-format} { test format-4.10 {g-format} { format "%.3g" .00012341 } {0.000123} -test format-4.11 {g-format} { +test format-4.11 {g-format} {eformat} { format "%.3g" .00001234 } {1.23e-05} -test format-4.12 {g-format} { +test format-4.12 {g-format} {eformat} { format "%.4g" 9999.6 } {1e+04} test format-4.13 {g-format} { @@ -181,29 +181,29 @@ test format-4.16 {g-format} { test format-4.17 {g-format} { format "%.3g" .001 } {0.001} -test format-4.18 {g-format} { +test format-4.18 {g-format} {eformat} { format "%.3g" .00001 } {1e-05} -test format-4.19 {g-format} { +test format-4.19 {g-format} {eformat} { format "%#.3g" 1234.0 } {1.23e+03} -test format-4.20 {g-format} { +test format-4.20 {g-format} {eformat} { format "%#.3G" 9999.5 } {1.00E+04} -test format-5.1 {floating-point zeroes} { +test format-5.1 {floating-point zeroes} {eformat} { format "%e %f %g" 0.0 0.0 0.0 0.0 } {0.000000e+00 0.000000 0} -test format-5.2 {floating-point zeroes} { +test format-5.2 {floating-point zeroes} {eformat} { format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0} -test format-5.3 {floating-point zeroes} { +test format-5.3 {floating-point zeroes} {eformat} { format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0.000} -test format-5.4 {floating-point zeroes} { +test format-5.4 {floating-point zeroes} {eformat} { format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0 } {0e+00 0 0} -test format-5.5 {floating-point zeroes} { +test format-5.5 {floating-point zeroes} {eformat} { format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0 } {0.e+00 0. 0.} test format-5.6 {floating-point zeroes} { diff --git a/tests/interp.test b/tests/interp.test index 715154c..8b77842 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.4 1998/10/14 21:12:09 rjohnson Exp $ +# RCS: @(#) $Id: interp.test,v 1.5 1998/11/02 23:04:14 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -189,6 +189,9 @@ test interp-4.7 {testing interp delete} { interp create c2 list [catch {interp delete c1 c2 c3} msg] $msg } {1 {interpreter named "c3" not found}} +test interp-4.8 {testing interp delete} { + list [catch {interp delete {}} msg] $msg +} {1 {interpreter named "" not found}} foreach i [interp slaves] { interp delete $i diff --git a/tests/io.test b/tests/io.test index 583e333..51dc6ae 100644 --- a/tests/io.test +++ b/tests/io.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.5 1998/10/30 00:38:39 welch Exp $ +# RCS: @(#) $Id: io.test,v 1.6 1998/11/02 23:04:14 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -5151,8 +5151,8 @@ test io-34.2 {buffered data and file events, read} { proc accept {sock args} { set ::s2 $sock } - set server [socket -server accept 4040] - set s [socket localhost 4040] + set server [socket -server accept 4041] + set s [socket localhost 4041] vwait s2 update fileevent $s2 readable {lappend result readable} @@ -5187,7 +5187,7 @@ test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} { } } close $out - set pipe [open "|$tcltest script" r] + set pipe [open "|[list $tcltest] script" r] fileevent $pipe readable [list readit $pipe] set x "" set result "" diff --git a/tests/registry.test b/tests/registry.test index e02a538..ab692aa 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -9,7 +9,7 @@ # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # -# RCS: @(#) $Id: registry.test,v 1.2 1998/09/14 18:40:13 stanton Exp $ +# RCS: @(#) $Id: registry.test,v 1.3 1998/11/02 23:04:14 stanton Exp $ if {$tcl_platform(platform) != "windows"} { return @@ -17,7 +17,10 @@ if {$tcl_platform(platform) != "windows"} { if {[string compare test [info procs test]] == 1} then {source defs} -if [catch {package require registry}] { +set lib [lindex [glob [file join [pwd] [file dirname \ + [info nameofexecutable]] tclreg*.dll]] 0] + +if [catch {load $lib registry}] { puts "Unable to find the registry package. Skipping registry tests." return } diff --git a/tests/safe.test b/tests/safe.test index 3ac1c10..c4e71a5 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.2 1998/09/14 18:40:13 stanton Exp $ +# RCS: @(#) $Id: safe.test,v 1.3 1998/11/02 23:04:14 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -169,7 +169,7 @@ test safe-6.2 {test safe interpreters knowledge of the world} { } {} test safe-6.3 {test safe interpreters knowledge of the world} { SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r -} {byteOrder platform} +} {byteOrder debug platform} # more test should be added to check that hostname, nameofexecutable, # aren't leaking infos, but they still do... diff --git a/tests/scan.test b/tests/scan.test index e95af35..ecbd79a 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: scan.test,v 1.2 1998/09/14 18:40:13 stanton Exp $ +# RCS: @(#) $Id: scan.test,v 1.3 1998/11/02 23:04:14 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -89,7 +89,7 @@ test scan-2.5 {floating-point scanning} { set a {}; set b {}; set c {}; set d {} list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d } {4 4.6 99999.7 87.643 118.0} -test scan-2.6 {floating-point scanning} { +test scan-2.6 {floating-point scanning} {eformat} { set a {}; set b {}; set c {}; set d {} list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d } {4 1.2345 0.697 124.0 5e-05} diff --git a/tests/util.test b/tests/util.test index bf9babe..a8c5241 100644 --- a/tests/util.test +++ b/tests/util.test @@ -6,7 +6,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.2 1998/09/14 18:40:14 stanton Exp $ +# RCS: @(#) $Id: util.test,v 1.3 1998/11/02 23:04:15 stanton Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" @@ -96,7 +96,7 @@ set tcl_precision 12 test util-6.4 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr 2.0] } {x2.0} -test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { +test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} { concat x[expr 3.0e98] } {x3e+98} diff --git a/tests/winPipe.test b/tests/winPipe.test index be6bbbc..62154ae 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -11,14 +11,15 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winPipe.test,v 1.3 1998/09/14 18:40:15 stanton Exp $ +# RCS: @(#) $Id: winPipe.test,v 1.4 1998/11/02 23:04:15 stanton Exp $ if {$tcl_platform(platform) != "windows"} { return } -set cat16 [file join $tcl_library ../win/cat16.exe] -set cat32 [file join $tcl_library ../win/cat32.exe] +set bindir [file join [pwd] [file dirname [info nameofexecutable]]] +set cat16 [file join $bindir cat16.exe] +set cat32 [file join $bindir cat32.exe] if {[string compare test [info procs test]] == 1} then {source defs} @@ -279,7 +280,7 @@ test winpipe-2.24 {16 bit comprehensive tests: read/write application} {nt} { } "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" } -test winpipe-3.1 {Tcl_WaitPid} {nt} { +test winpipe-4.1 {Tcl_WaitPid} {nt} { proc readResults {f} { global x result if { [eof $f] } { diff --git a/win/makefile.vc b/win/makefile.vc index 25d976d..9d51847 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -4,7 +4,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. -# RCS: @(#) $Id: makefile.vc,v 1.20 1998/11/02 19:36:54 suresh Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.21 1998/11/02 23:04:15 stanton Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -287,7 +287,9 @@ all: setup $(TCLSH) dlls $(CAT16) $(CAT32) tcltest: setup $(TCLTEST) dlls $(CAT16) $(CAT32) plugin: setup $(TCLPLUGINDLL) $(TCLSHP) install: install-binaries install-libraries -test: setup $(TCLTEST) dlls $(CAT16) $(CAT32) +test: setup $(TCLTEST) dlls $(CAT16) $(CAT32) + copy $(WINDIR)\pkgIndex.tcl $(OUTDIR) + set TCL_LIBRARY=$(ROOT)/library $(TCLTEST) << cd ../tests source all -- cgit v0.12