diff options
| author | stanton <stanton> | 1998-09-24 23:58:14 (GMT) |
|---|---|---|
| committer | stanton <stanton> | 1998-09-24 23:58:14 (GMT) |
| commit | 9995355714bc90faf7c2e345b3d6a1d041447097 (patch) | |
| tree | 2ad97c5b1994495118cef4df947cf16b55e326f2 /tests | |
| parent | e13392595faf8e8d0d1c3c514ce160cfadc3d372 (diff) | |
| download | tcl-9995355714bc90faf7c2e345b3d6a1d041447097.zip tcl-9995355714bc90faf7c2e345b3d6a1d041447097.tar.gz tcl-9995355714bc90faf7c2e345b3d6a1d041447097.tar.bz2 | |
merging changes from 8.0.3 into 8.1a2
Diffstat (limited to 'tests')
101 files changed, 996 insertions, 129 deletions
diff --git a/tests/README b/tests/README index 7dce2a2..3bfb3c9 100644 --- a/tests/README +++ b/tests/README @@ -1,7 +1,7 @@ Tcl Test Suite -------------- -SCCS: @(#) README 1.6 96/04/17 10:51:11 +RCS: @(#) $Id: README,v 1.1.2.1 1998/09/24 23:59:19 stanton Exp $ This directory contains a set of validation tests for the Tcl commands. Each of the files whose name ends in ".test" is diff --git a/tests/append.test b/tests/append.test index cac10ba..d25e141 100644 --- a/tests/append.test +++ b/tests/append.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. # -# SCCS: @(#) append.test 1.19 97/12/24 10:40:56 +# RCS: @(#) $Id: append.test,v 1.1.2.2 1998/09/24 23:59:19 stanton Exp $ if {[info procs test] != "test"} {source defs} diff --git a/tests/assocd.test b/tests/assocd.test index 6d8fac5..839c11f 100644 --- a/tests/assocd.test +++ b/tests/assocd.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. # -# "@(#) assocd.test 1.6 97/12/08 15:04:52" +# RCS: @(#) $Id: assocd.test,v 1.1.2.2 1998/09/24 23:59:19 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/async.test b/tests/async.test index 1933111..1b3ef90 100644 --- a/tests/async.test +++ b/tests/async.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. # -# SCCS: @(#) async.test 1.6 97/12/08 15:02:15 +# RCS: @(#) $Id: async.test,v 1.1.2.2 1998/09/24 23:59:19 stanton Exp $ if {[info commands testasync] == {}} { puts "This application hasn't been compiled with the \"testasync\"" diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test new file mode 100644 index 0000000..11db5f0 --- /dev/null +++ b/tests/autoMkindex.test @@ -0,0 +1,55 @@ +# Commands covered: auto_mkindex auto_import +# +# This file contains tests related to autoloading and generating +# the autoloading index. +# +# Copyright (c) 1998 Lucent Technologies, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: autoMkindex.test,v 1.1.2.1 1998/09/24 23:59:19 stanton Exp $ + +if {[string compare test [info procs test]] == 1} then {source defs} + +test autoMkindex-1.1 {remove any existing tclIndex file} { + file delete tclIndex + file exists tclIndex +} {0} + +test autoMkindex-1.2 {build tclIndex based on a test file} { + auto_mkindex . autoMkindex.tcl + file exists tclIndex +} {1} + +set element "{source [file join . autoMkindex.tcl]}" + +test autoMkindex-1.3 {examine tclIndex} { + namespace eval tcl_autoMkindex_tmp { + set dir "." + variable auto_index + source tclIndex + set result "" + foreach elem [lsort [array names auto_index]] { + lappend result [list $elem $auto_index($elem)] + } + set result + } +} "{::buried::explicit $element} {::buried::inside $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}" + +namespace delete tcl_autoMkindex_tmp + +test autoMkindex-2.1 {commands on the autoload path can be imported} { + set interp [interp create] + set final [$interp eval { + namespace eval blt {} + set auto_path [linsert $auto_path 0 .] + set info [list [catch {namespace import buried::*} result] $result] + foreach name [lsort [info commands pub_*]] { + lappend info $name [namespace origin $name] + } + set info + }] + interp delete $interp + set final +} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two" diff --git a/tests/basic.test b/tests/basic.test index b4b8c55..a339768 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -14,16 +14,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) basic.test 1.23 97/12/09 16:34:32 +# RCS: @(#) $Id: basic.test,v 1.1.2.2 1998/09/24 23:59:20 stanton Exp $ # if {[string compare test [info procs test]] == 1} then {source defs} -if {[info commands testcreatecommand] == ""} { - puts "This application hasn't been compiled with the testcreatecommand" - puts "command. Skipping all of these tests." -} - catch {namespace delete test_ns_basic} catch {interp delete test_interp} catch {rename p ""} @@ -199,6 +194,10 @@ test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expo [p] } {42 {} {} Hello {} {} 42} +if {[info commands testcreatecommand] == ""} { + puts "This application hasn't been compiled with the testcreatecommand" + puts "command. Skipping affected tests." +} else { test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} { catch {eval namespace delete [namespace children :: test_ns_*]} list [testcreatecommand create] \ @@ -212,6 +211,7 @@ test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle [value:at:] \ [testcreatecommand delete2] } {{} {CreatedCommandProc2 in ::} {}} +} test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} { catch {eval namespace delete [namespace children :: test_ns_*]} @@ -296,6 +296,10 @@ test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed test basic-19.1 {Tcl_SetCommandInfo} { } {} +if {[info commands testcmdtoken] == {}} { + puts "This application hasn't been compiled with the \"testcmdtoken\"" + puts "command, so I can't test Tcl_GetCommandInfo." +} else { test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename p ""} @@ -316,6 +320,7 @@ test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespac [rename test_ns_basic::test_ns_basic2::p q] \ [testcmdtoken name $x] } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}} +} test basic-21.1 {Tcl_GetCommandName} { } {} @@ -476,6 +481,10 @@ test basic-37.1 {Tcl_ExprString: see expr.test} { test basic-38.1 {Tcl_ExprObj} { } {} +if {[info commands testcmdtrace] == {}} { + puts "This application hasn't been compiled with the \"testcmdtrace\"" + puts "command, so I can't test Tcl_CreateTrace." +} else { test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} { testcmdtrace tracetest {set stuff [expr 14 + 16]} } {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}} @@ -485,6 +494,7 @@ test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of tra test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} { testcmdtrace deletetest {set stuff [info tclversion]} } 8.1 +} test basic-40.1 {Tcl_DeleteTrace} { } {} diff --git a/tests/binary.test b/tests/binary.test index 4f49acd..f978147 100644 --- a/tests/binary.test +++ b/tests/binary.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. # -# SCCS: @(#) binary.test 1.15 98/01/07 16:22:49 +# RCS: @(#) $Id: binary.test,v 1.1.2.2 1998/09/24 23:59:20 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/case.test b/tests/case.test index bd7d870..4eb3624 100644 --- a/tests/case.test +++ b/tests/case.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. # -# SCCS: @(#) case.test 1.14 97/12/08 15:02:20 +# RCS: @(#) $Id: case.test,v 1.1.2.2 1998/09/24 23:59:20 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/clock.test b/tests/clock.test index 6af00ec..0a5e1ca 100644 --- a/tests/clock.test +++ b/tests/clock.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. # -# SCCS: @(#) clock.test 1.22 98/02/02 22:03:36 +# RCS: @(#) $Id: clock.test,v 1.1.2.2 1998/09/24 23:59:20 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 4c23dae..2e473fe 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -9,12 +9,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) cmdAH.test 1.41 98/02/02 21:59:54 +# RCS: @(#) $Id: cmdAH.test,v 1.1.2.2 1998/09/24 23:59:20 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} global env -set platform [testgetplatform] +catch {set platform [testgetplatform]} test cmdAH-1.1 {Tcl_CdObjCmd} { list [catch {cd foo bar} msg] $msg @@ -107,6 +107,10 @@ test cmdAH-4.1 {Tcl_FileObjCmd - file attrs} { # dirname +if {[info commands testsetplatform] == {}} { + puts "This application hasn't been compiled with the \"testsetplatform\"" + puts "command, so I can't test Tcl_FileObjCmd etc." +} else { test cmdAH-5.1 {Tcl_FileObjCmd: dirname} { testsetplatform unix list [catch {file dirname a b} msg] $msg @@ -895,11 +899,17 @@ test cmdAH-12.1 {Tcl_FileObjCmd} { } {1 {user "_bad_user" doesn't exist}} testsetplatform $platform -makeFile abcde gorp.file -makeDirectory dir.file +} # readable +if {[info commands testchmod] == {}} { + puts "This application hasn't been compiled with the \"testchmod\"" + puts "command, so I can't test Tcl_FileObjCmd etc." +} else { +makeFile abcde gorp.file +makeDirectory dir.file + test cmdAH-13.1 {Tcl_FileObjCmd: readable} { list [catch {file readable a b} msg] $msg } {1 {wrong # args: should be "file readable name"}} @@ -971,6 +981,8 @@ test cmdAH-15.6 {Tcl_FileObjCmd: executable} { file delete -force dir.file file delete gorp.file file delete link.file +} + # exists test cmdAH-16.1 {Tcl_FileObjCmd: exists} { @@ -993,6 +1005,10 @@ test cmdAH-16.5 {Tcl_FileObjCmd: exists} { } 1 # nativename +if {[info commands testsetplatform] == {}} { + puts "This application hasn't been compiled with the \"testsetplatform\"" + puts "command, so I can't test Tcl_FileObjCmd etc." +} else { test cmdAH-16.6 {Tcl_FileObjCmd: nativename} { testsetplatform unix list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] @@ -1005,6 +1021,7 @@ test cmdAH-16.8 {Tcl_FileObjCmd: nativename} { testsetplatform mac list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] } {0 :a:b {}} +} test cmdAH-16.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR @@ -1036,7 +1053,7 @@ if {$tcl_platform(platform) == "unix"} { # Stat related commands -testsetplatform $platform +catch {testsetplatform $platform} file delete gorp.file makeFile "Test string" gorp.file catch {exec chmod 765 gorp.file} @@ -1206,7 +1223,7 @@ test cmdAH-24.3 {Tcl_FileObjCmd: size} { # stat -testsetplatform $platform +catch {testsetplatform $platform} makeFile "Test string" gorp.file catch {exec chmod 765 gorp.file} @@ -1344,7 +1361,7 @@ test cmdAH-27.8 {error conditions} { list [catch {file dirname ~woohgy} msg] $msg } {1 {user "woohgy" doesn't exist}} -testsetplatform $platform +catch {testsetplatform $platform} catch {unset platform} catch {exec chmod 777 dir.file} diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 572c77e..58b83d4 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) cmdIL.test 1.22 98/01/13 18:24:45 +# RCS: @(#) $Id: cmdIL.test,v 1.1.2.2 1998/09/24 23:59:21 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -263,5 +263,42 @@ test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoL restore_locale set result } "a23\xe3 a23\xe4 a23\xc5" - +test cmdIL-4.26 {DefaultCompare procedure, signed characters} { + set l [lsort [list "abc\200" "abc"]] + set viewlist {} + foreach s $l { + set viewelem "" + set len [string length $s] + for {set i 0} {$i < $len} {incr i} { + set c [string index $s $i] + scan $c %c d + if {$d > 0 && $d < 128} { + append viewelem $c + } else { + append viewelem "\\[format %03o $d]" + } + } + lappend viewlist $viewelem + } + set viewlist +} [list "abc" "abc\\200"] +test cmdIL-4.27 {DictionaryCompare procedure, signed characters} { + set l [lsort -dictionary [list "abc\200" "abc"]] + set viewlist {} + foreach s $l { + set viewelem "" + set len [string length $s] + for {set i 0} {$i < $len} {incr i} { + set c [string index $s $i] + scan $c %c d + if {$d > 0 && $d < 128} { + append viewelem $c + } else { + append viewelem "\\[format %03o $d]" + } + } + lappend viewlist $viewelem + } + set viewlist +} [list "abc" "abc\\200"] return diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index 2b2b00b..ffc9c61 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.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. # -# SCCS: @(#) cmdInfo.test 1.11 97/12/08 15:05:59 +# RCS: @(#) $Id: cmdInfo.test,v 1.1.2.2 1998/09/24 23:59:21 stanton Exp $ if {[info commands testcmdinfo] == {}} { puts "This application hasn't been compiled with the \"testcmdinfo\"" diff --git a/tests/compile.test b/tests/compile.test index 53dc3d8..e5995c8 100644 --- a/tests/compile.test +++ b/tests/compile.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. # -# SCCS: @(#) compile.test 1.9 97/12/16 13:32:14 +# RCS: @(#) $Id: compile.test,v 1.1.2.2 1998/09/24 23:59:21 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -78,8 +78,44 @@ test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compi } list [p] $a(1) } {0 123} +test compile-3.2 {TclCompileCatchCmd: non-local variables} { + set ::foo 1 + proc catch-test {} { + catch {set x 3} ::foo + } + catch-test + set ::foo +} 3 + +test compile-4.1 {TclCompileForCmd: command substituted test expression} { + set i 0 + set j 0 + # Should be "forever" + for {} [expr $i < 3] {} { + set j [incr i] + if {$j > 3} break + } + set j +} {4} -test compile-4.1 {TclCompileSetCmd: global scalar names with ::s} { +test compile-5.1 {TclCompileForeachCmd: exception stack} { + proc foreach-exception-test {} { + foreach array(index) [list 1 2 3] break + foreach array(index) [list 1 2 3] break + foreach scalar [list 1 2 3] break + } + list [catch foreach-exception-test result] $result +} {0 {}} +test compile-5.2 {TclCompileForeachCmd: non-local variables} { + set ::foo 1 + proc foreach-test {} { + foreach ::foo {1 2 3} {} + } + foreach-test + set ::foo +} 3 + +test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} { catch {unset x} catch {unset y} set x 123 @@ -90,7 +126,7 @@ test compile-4.1 {TclCompileSetCmd: global scalar names with ::s} { list $::x [expr {[lsearch -exact [info globals] x] != 0}] \ [p] $::y [expr {[lsearch -exact [info globals] y] != 0}] } {123 1 789 789 1} -test compile-4.2 {TclCompileSetCmd: global array names with ::s} { +test compile-6.2 {TclCompileSetCmd: global array names with ::s} { catch {unset a} set ::a(1) 2 proc p {} { @@ -99,7 +135,7 @@ test compile-4.2 {TclCompileSetCmd: global array names with ::s} { } list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}] } {2 1 3 3 1} -test compile-4.3 {TclCompileSetCmd: namespace var names with ::s} { +test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} { catch {namespace delete test_ns_compile} catch {unset x} namespace eval test_ns_compile { @@ -111,17 +147,28 @@ test compile-4.3 {TclCompileSetCmd: namespace var names with ::s} { list $::x $::test_ns_compile::arr(1) } {hello 123} -test compile-5.1 {CollectArgInfo: binary data} { +test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { + set i 0 + set j 0 + # Should be "forever" + while [expr $i < 3] { + set j [incr i] + if {$j > 3} break + } + set j +} {4} + +test compile-8.1 {CollectArgInfo: binary data} { list [catch "string length \000foo" msg] $msg } {0 4} -test compile-5.2 {CollectArgInfo: binary data} { +test compile-8.2 {CollectArgInfo: binary data} { list [catch "string length foo\000" msg] $msg } {0 4} -test compile-5.3 {CollectArgInfo: handle "]" at end of command properly} { +test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} { set x ] } {]} -test compile-6.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} { +test compile-9.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} { proc p {} { set x {} eval $x @@ -138,3 +185,4 @@ catch {unset y} catch {unset a} return + diff --git a/tests/concat.test b/tests/concat.test index 99972e9..60ce0b3 100644 --- a/tests/concat.test +++ b/tests/concat.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. # -# SCCS: @(#) concat.test 1.11 97/12/08 15:02:29 +# RCS: @(#) $Id: concat.test,v 1.1.2.2 1998/09/24 23:59:21 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/dcall.test b/tests/dcall.test index 8ab615e..91dd757 100644 --- a/tests/dcall.test +++ b/tests/dcall.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. # -# SCCS: @(#) dcall.test 1.7 97/12/08 15:02:32 +# RCS: @(#) $Id: dcall.test,v 1.1.2.2 1998/09/24 23:59:22 stanton Exp $ if {[info commands testdcall] == {}} { puts "This application hasn't been compiled with the \"testdcall\"" @@ -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. # -# SCCS: @(#) defs 1.72 98/01/15 18:41:39 +# RCS: @(#) $Id: defs,v 1.1.2.2 1998/09/24 23:59:22 stanton Exp $ if ![info exists VERBOSE] { set VERBOSE 0 @@ -512,6 +512,7 @@ if {$tcl_platform(os) != "Win32s"} { close $f set testConfig(stdio) 1 } + catch {file delete -force tmp} } if {($tcl_platform(platform) == "windows") && ($testConfig(stdio) == 0)} { diff --git a/tests/dstring.test b/tests/dstring.test index 23f37c7..3c591e2 100644 --- a/tests/dstring.test +++ b/tests/dstring.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. # -# SCCS: @(#) dstring.test 1.11 97/12/08 15:02:36 +# RCS: @(#) $Id: dstring.test,v 1.1.2.2 1998/09/24 23:59:22 stanton Exp $ if {[info commands testdstring] == {}} { puts "This application hasn't been compiled with the \"testdstring\"" diff --git a/tests/env.test b/tests/env.test index cd2c354..b3064b8 100644 --- a/tests/env.test +++ b/tests/env.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. # -# SCCS: @(#) env.test 1.18 98/02/17 23:45:10 +# RCS: @(#) $Id: env.test,v 1.1.2.2 1998/09/24 23:59:22 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/error.test b/tests/error.test index 1e52543..512a15c 100644 --- a/tests/error.test +++ b/tests/error.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. # -# SCCS: @(#) error.test 1.23 97/12/08 15:02:42 +# RCS: @(#) $Id: error.test,v 1.1.2.2 1998/09/24 23:59:22 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/eval.test b/tests/eval.test index 1506baf..d523f85 100644 --- a/tests/eval.test +++ b/tests/eval.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. # -# SCCS: @(#) eval.test 1.11 97/12/08 15:02:45 +# RCS: @(#) $Id: eval.test,v 1.1.2.2 1998/09/24 23:59:23 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/event.test b/tests/event.test index 2dc6eb6..a4e9c95 100644 --- a/tests/event.test +++ b/tests/event.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# "@(#) event.test 1.36 97/12/08 15:05:00" +# RCS: @(#) $Id: event.test,v 1.1.2.2 1998/09/24 23:59:23 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -384,8 +384,8 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc puts $s foobar close $s } - set s1 [socket -server accept 5000] - set s2 [socket 127.0.0.1 5000] + set s1 [socket -server accept 5001] + set s2 [socket 127.0.0.1 5001] close $s1 set x 0 set y 0 diff --git a/tests/exec.test b/tests/exec.test index fb0355d..a5095f7 100644 --- a/tests/exec.test +++ b/tests/exec.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. # -# SCCS: @(#) exec.test 1.62 97/12/24 13:42:34 +# RCS: @(#) $Id: exec.test,v 1.1.2.2 1998/09/24 23:59:23 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/execute.test b/tests/execute.test index 092dcfd..7459b5b 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) execute.test 1.6 97/12/08 15:07:24 +# RCS: @(#) $Id: execute.test,v 1.1.2.2 1998/09/24 23:59:23 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/expr-old.test b/tests/expr-old.test index 98251be..2d0c8a2 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. # -# SCCS: @(#) expr-old.test 1.68 97/12/16 13:32:24 +# RCS: @(#) $Id: expr-old.test,v 1.1.2.2 1998/09/24 23:59:24 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -900,15 +900,24 @@ test expr-old-36.10 {ExprLooksLikeInt procedure} {nonPortable unixOnly} { list [catch {expr 78e} msg] $msg } {1 {syntax error in expression "78e"}} +if {[info commands testexprlong] == {}} { + puts "This application hasn't been compiled with the \"testexprlong\"" + puts "command, so I can't test Tcl_ExprLong etc." +} else { test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} { testexprlong } {This is a result: 5} +} +if {[info commands testexprstring] == {}} { + puts "This application hasn't been compiled with the \"testexprstring\"" + puts "command, so I can't test Tcl_ExprString etc." +} else { test expr-old-38.1 {Verify Tcl_ExprString's basic operation} { list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \ [catch {testexprstring "1+"} msg] $msg } {5 10.2 1 {syntax error in expression "1+"}} - +} # Special test for Pentium arithmetic bug of 1994: diff --git a/tests/expr.test b/tests/expr.test index 3c4779f..3c743ce 100644 --- a/tests/expr.test +++ b/tests/expr.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. # -# SCCS: @(#) expr.test 1.39 97/11/03 16:04:47 +# RCS: @(#) $Id: expr.test,v 1.1.2.1 1998/09/24 23:59:24 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/fCmd.test b/tests/fCmd.test index 139ecab..2544a3f 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.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. # -# SCCS: @(#) fCmd.test 1.37 98/01/18 15:47:02 +# RCS: @(#) $Id: fCmd.test,v 1.1.2.2 1998/09/24 23:59:24 stanton Exp $ # if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/fileName.test b/tests/fileName.test index 585a41b..3ffe4da 100644 --- a/tests/fileName.test +++ b/tests/fileName.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. # -# SCCS: @(#) fileName.test 1.34 98/01/07 16:23:09 +# RCS: @(#) $Id: fileName.test,v 1.1.2.2 1998/09/24 23:59:24 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/for-old.test b/tests/for-old.test index 29330ea..3367d34 100644 --- a/tests/for-old.test +++ b/tests/for-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. # -# SCCS: @(#) for-old.test 1.15 97/12/08 15:06:07 +# RCS: @(#) $Id: for-old.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/for.test b/tests/for.test index f6d4324..ceb70c2 100644 --- a/tests/for.test +++ b/tests/for.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. # -# SCCS: @(#) for.test 1.13 97/12/08 15:02:58 +# RCS: @(#) $Id: for.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/foreach.test b/tests/foreach.test index ef29d7c..8032ea1 100644 --- a/tests/foreach.test +++ b/tests/foreach.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. # -# SCCS: @(#) foreach.test 1.9 97/12/08 15:06:20 +# RCS: @(#) $Id: foreach.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/format.test b/tests/format.test index 6a67fb4..e6261c1 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. # -# SCCS: @(#) format.test 1.31 98/01/16 16:21:58 +# RCS: @(#) $Id: format.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[info commands test] != "test"} { source defs diff --git a/tests/get.test b/tests/get.test index 8ba8be0..b198a1f 100644 --- a/tests/get.test +++ b/tests/get.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. # -# SCCS: @(#) get.test 1.9 97/12/19 11:57:36 +# RCS: @(#) $Id: get.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/history.test b/tests/history.test index 317fc06..d878d0a 100644 --- a/tests/history.test +++ b/tests/history.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. # -# SCCS: @(#) history.test 1.16 97/12/08 15:03:07 +# RCS: @(#) $Id: history.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[catch {history}]} { puts stdout "This version of Tcl was built without the history command;\n" diff --git a/tests/http.test b/tests/http.test index be43f21..3a0e420 100644 --- a/tests/http.test +++ b/tests/http.test @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# SCCS: @(#) http.test 1.11 98/02/20 14:51:59 +# RCS: @(#) $Id: http.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/httpold.test b/tests/httpold.test index 5e9ba0c..3873639 100644 --- a/tests/httpold.test +++ b/tests/httpold.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. # -# SCCS: @(#) http.test 1.12 97/07/29 17:04:12 +# RCS: @(#) $Id: httpold.test,v 1.1.2.1 1998/09/24 23:59:25 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/if-old.test b/tests/if-old.test index d4c3587..59974cd 100644 --- a/tests/if-old.test +++ b/tests/if-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. # -# SCCS: @(#) if-old.test 1.11 97/12/08 15:06:04 +# RCS: @(#) $Id: if-old.test,v 1.1.2.2 1998/09/24 23:59:26 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/if.test b/tests/if.test index 79d4bbe..cfd3876 100644 --- a/tests/if.test +++ b/tests/if.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. # -# SCCS: @(#) if.test 1.11 97/12/08 15:02:55 +# RCS: @(#) $Id: if.test,v 1.1.2.2 1998/09/24 23:59:26 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/incr-old.test b/tests/incr-old.test index 710896c..570aae7 100644 --- a/tests/incr-old.test +++ b/tests/incr-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. # -# SCCS: @(#) incr-old.test 1.12 97/12/08 15:06:10 +# RCS: @(#) $Id: incr-old.test,v 1.1.2.2 1998/09/24 23:59:26 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/incr.test b/tests/incr.test index 8dd9cce..fabbd6c 100644 --- a/tests/incr.test +++ b/tests/incr.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. # -# SCCS: @(#) incr.test 1.13 97/12/16 13:32:33 +# RCS: @(#) $Id: incr.test,v 1.1.2.2 1998/09/24 23:59:26 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/indexObj.test b/tests/indexObj.test index cbe32e8..f06c0c5 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# @(#) indexObj.test 1.4 97/12/08 15:06:27 +# RCS: @(#) $Id: indexObj.test,v 1.1.2.2 1998/09/24 23:59:26 stanton Exp $ if {[info procs test] != "test"} { source defs diff --git a/tests/info.test b/tests/info.test index 7bc5e84..d45d44c 100644 --- a/tests/info.test +++ b/tests/info.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. # -# SCCS: @(#) info.test 1.43 98/02/11 17:28:43 +# RCS: @(#) $Id: info.test,v 1.1.2.2 1998/09/24 23:59:26 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -350,6 +350,13 @@ test info-12.6 {info locals vs unset compiled locals} { } lsort [t1 {a b c c d e f}] } {a b c d e f} +test info-12.7 {info locals with temporary variables} { + proc t1 {} { + foreach a {b c} {} + info locals + } + t1 +} {a} test info-13.1 {info nameofexecutable option} { list [catch {info nameofexecutable foo} msg] $msg @@ -467,6 +474,13 @@ test info-19.3 {info vars option} { test info-19.4 {info vars option} { list [catch {info vars a b} msg] $msg } {1 {wrong # args: should be "info vars ?pattern?"}} +test info-19.5 {info vars with temporary variables} { + proc t1 {} { + foreach a {b c} {} + info vars + } + t1 +} {a} test info-20.1 {miscellaneous error conditions} { list [catch {info} msg] $msg diff --git a/tests/init.test b/tests/init.test index 658b998..f2504bd 100644 --- a/tests/init.test +++ b/tests/init.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. # -# SCCS: @(#) init.test 1.6 97/12/08 15:07:52 +# RCS: @(#) $Id: init.test,v 1.1.2.2 1998/09/24 23:59:27 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/interp.test b/tests/interp.test index 4c43edb..ac8f792 100644 --- a/tests/interp.test +++ b/tests/interp.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. # -# SCCS: @(#) interp.test 1.70 98/02/17 23:45:11 +# RCS: @(#) $Id: interp.test,v 1.1.2.2 1998/09/24 23:59:27 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -146,8 +146,8 @@ test interp-3.8 {testing interp exists and interp slaves} { } {1 {wrong # args: should be "interp slaves ?path?"}} test interp-3.9 {testing interp exists and interp slaves} { interp create {a a2} -safe - interp slaves a -} {a2} + expr {[lsearch [interp slaves a] a2] >= 0} +} 1 test interp-3.10 {testing interp exists and interp slaves} { interp exists {a a2} } 1 @@ -173,8 +173,8 @@ test interp-4.5 {testing interp delete} { interp create a interp create {a x1} interp delete {a x1} - interp slaves a -} "" + expr {[lsearch [interp slaves a] x1] >= 0} +} 0 test interp-4.6 {testing interp delete} { interp create c1 interp create c2 diff --git a/tests/io.test b/tests/io.test index 2f55660..d90d1c0 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. # -# SCCS: @(#) io.test 1.149 98/02/10 17:49:32 +# RCS: @(#) $Id: io.test,v 1.1.2.2 1998/09/24 23:59:27 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -6680,6 +6680,51 @@ test io-56.1 {ChannelTimerProc} { lappend result $y } {2 done} +test io-34.1 {buffered data and file events, gets} { + proc accept {sock args} { + set ::s2 $sock + } + set server [socket -server accept 4040] + set s [socket localhost 4040] + vwait s2 + update + fileevent $s2 readable {lappend result readable} + puts $s "12\n34567890" + flush $s + set result [gets $s2] + after 1000 {lappend result timer} + vwait result + lappend result [gets $s2] + vwait result + close $s + close $s2 + close $server + set result +} {12 readable 34567890 timer} +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] + vwait s2 + update + fileevent $s2 readable {lappend result readable} + puts -nonewline $s "1234567890" + flush $s + set result [read $s2 1] + after 1000 {lappend result timer} + vwait result + lappend result [read $s2 9] + vwait result + close $s + close $s2 + close $server + set result +} {1 readable 234567890 timer} + + + removeFile fooBar removeFile longfile removeFile script diff --git a/tests/ioCmd.test b/tests/ioCmd.test index e8eb96c..223be22 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.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. # -# "@(#) ioCmd.test 1.53 98/01/07 16:23:34" +# RCS: @(#) $Id: ioCmd.test,v 1.1.2.2 1998/09/24 23:59:28 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/ioUtil.test b/tests/ioUtil.test new file mode 100644 index 0000000..4e86353 --- /dev/null +++ b/tests/ioUtil.test @@ -0,0 +1,300 @@ +# This file (iOUtil.test) tests the hookable TclStat(), TclAccess(), +# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. +# Sourcing this file into Tcl runs the tests and generates output for +# errors. No output means no errors were found. +# +# 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: ioUtil.test,v 1.1.2.1 1998/09/24 23:59:26 stanton Exp $ + +if {[string compare test [info procs test]] == 1} then {source defs} + +set unsetScript { + catch {unset testStat1(size)} + catch {unset testStat2(size)} + catch {unset testStat3(size)} +} + +test stat-1.1 {TclStat: Check that none of the test procs are there.} { + catch {file stat testStat1%.fil testStat1} err1 + catch {file stat testStat2%.fil testStat2} err2 + catch {file stat testStat3%.fil testStat3} err3 + list $err1 $err2 $err3 +} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}} + +if {[info commands teststatproc] == {}} { + puts "This application hasn't been compiled with the \"teststatproc\"" + puts "command, so I can't test Tcl_Stat_* etc." +} else { +test stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} { + catch {teststatproc insert TclpStat} err1 + teststatproc insert TestStatProc1 + teststatproc insert TestStatProc2 + teststatproc insert TestStatProc3 + set err1 +} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3} + +test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} { + file stat testStat2%.fil testStat2 + file stat testStat1%.fil testStat1 + file stat testStat3%.fil testStat3 + + list $testStat2(size) $testStat1(size) $testStat3(size) +} {2345 1234 3456} + +eval $unsetScript + +test stat-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} { + catch {teststatproc delete TclpStat} err2 + set err2 +} {"TclpStat": could not be deleteed} + +test stat-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} { + # Delete the 2nd procedure and test that it longer exists but that + # the others do actually return a result. + + teststatproc delete TestStatProc2 + file stat testStat1%.fil testStat1 + catch {file stat testStat2%.fil testStat2} err3 + file stat testStat3%.fil testStat3 + + list $testStat1(size) $err3 $testStat3(size) +} {1234 {couldn't stat "testStat2%.fil": no such file or directory} 3456} + +eval $unsetScript + +test stat-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} { + # Next delete the 1st procedure and test that only the 3rd procedure + # is the only one that exists. + + teststatproc delete TestStatProc1 + catch {file stat testStat1%.fil testStat1} err4 + catch {file stat testStat2%.fil testStat2} err5 + file stat testStat3%.fil testStat3 + + list $err4 $err5 $testStat3(size) +} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} 3456} + +eval $unsetScript + +test stat-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} { + # Finally delete the 3rd procedure and check that none of the + # procedures exist. + + teststatproc delete TestStatProc3 + catch {file stat testStat1%.fil testStat1} err6 + catch {file stat testStat2%.fil testStat2} err7 + catch {file stat testStat3%.fil testStat3} err8 + + list $err6 $err7 $err8 +} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}} + +eval $unsetScript + +test stat-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} { + # Attempt to delete all the Stat procs. again to ensure they no longer + # exist and an error is returned. + + catch {teststatproc delete TestStatProc1} err9 + catch {teststatproc delete TestStatProc2} err10 + catch {teststatproc delete TestStatProc3} err11 + + list $err9 $err10 $err11 +} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}} +} + +eval $unsetScript + + +test access-1.1 {TclAccess: Check that none of the test procs are there.} { + catch {file exists testAccess1%.fil} err1 + catch {file exists testAccess2%.fil} err2 + catch {file exists testAccess3%.fil} err3 + list $err1 $err2 $err3 +} {0 0 0} + +if {[info commands testaccessproc] == {}} { + puts "This application hasn't been compiled with the \"testaccessproc\"" + puts "command, so I can't test Tcl_Access_* etc." +} else { +test access-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} { + catch {testaccessproc insert TclpAccess} err1 + testaccessproc insert TestAccessProc1 + testaccessproc insert TestAccessProc2 + testaccessproc insert TestAccessProc3 + set err1 +} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3} + +test access-1.3 {TclAccess: Use "file access ?" to invoke each procedure.} { + list \ + [file exists testAccess2%.fil] \ + [file exists testAccess1%.fil] \ + [file exists testAccess3%.fil] +} {1 1 1} + +test access-1.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletedable.} { + catch {testaccessproc delete TclpAccess} err2 + set err2 +} {"TclpAccess": could not be deleteed} + +test accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} { + # Delete the 2nd procedure and test that it longer exists but that + # the others do actually return a result. + + testaccessproc delete TestAccessProc2 + set res1 [file exists testAccess1%.fil] + catch {file exists testAccess2%.fil} err3 + set res2 [file exists testAccess3%.fil] + + list $res1 $err3 $res2 +} {1 0 1} + +test access-1.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} { + # Next delete the 1st procedure and test that only the 3rd procedure + # is the only one that exists. + + testaccessproc delete TestAccessProc1 + catch {file exists testAccess1%.fil} err4 + catch {file exists testAccess2%.fil} err5 + set res3 [file exists testAccess3%.fil] + + list $err4 $err5 $res3 +} {0 0 1} + +test access-1.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} { + # Finally delete the 3rd procedure and check that none of the + # procedures exist. + + testaccessproc delete TestAccessProc3 + catch {file exists testAccess1%.fil} err6 + catch {file exists testAccess2%.fil} err7 + catch {file exists testAccess3%.fil} err8 + + list $err6 $err7 $err8 +} {0 0 0} + +test access-1.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} { + # Attempt to delete all the Access procs. again to ensure they no longer + # exist and an error is returned. + + catch {testaccessproc delete TestAccessProc1} err9 + catch {testaccessproc delete TestAccessProc2} err10 + catch {testaccessproc delete TestAccessProc3} err11 + + list $err9 $err10 $err11 +} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}} +} + +test openfilechannel-1.1 {TclOpenFileChannel: Check that none of the test procs are there.} { + catch {file exists __testOpenFileChannel1%__.fil} err1 + catch {file exists __testOpenFileChannel2%__.fil} err2 + catch {file exists __testOpenFileChannel3%__.fil} err3 + catch {file exists __testOpenFileChannel1%__.fil} err4 + catch {file exists __testOpenFileChannel2%__.fil} err5 + catch {file exists __testOpenFileChannel3%__.fil} err6 + list $err1 $err2 $err3 $err4 $err5 $err6 +} {0 0 0 0 0 0} + +if {[info commands testopenfilechannelproc] == {}} { + puts "This application hasn't been compiled with the \"testopenfilechannelproc\"" + puts "command, so I can't test Tcl_OpenFileChannelInsert" +} else { +test openfilechannel-1.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} { + catch {testopenfilechannelproc insert TclpOpenFileChannel} err1 + testopenfilechannelproc insert TestOpenFileChannelProc1 + testopenfilechannelproc insert TestOpenFileChannelProc2 + testopenfilechannelproc insert TestOpenFileChannelProc3 + set err1 +} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3} + +test openfilechannel-1.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} { + close [open __testOpenFileChannel1%__.fil w] + close [open __testOpenFileChannel2%__.fil w] + close [open __testOpenFileChannel3%__.fil w] + + catch { + close [open testOpenFileChannel1%.fil r] + close [open testOpenFileChannel2%.fil r] + close [open testOpenFileChannel3%.fil r] + } err + + file delete __testOpenFileChannel1%__.fil + file delete __testOpenFileChannel2%__.fil + file delete __testOpenFileChannel3%__.fil + + set err +} {} + +test openfilechannel-1.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} { + catch {testopenfilechannelproc delete TclpOpenFileChannel} err2 + set err2 +} {"TclpOpenFileChannel": could not be deleteed} + +test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} { + # Delete the 2nd procedure and test that it longer exists but that + # the others do actually return a result. + + testopenfilechannelproc delete TestOpenFileChannelProc2 + + close [open __testOpenFileChannel1%__.fil w] + close [open __testOpenFileChannel3%__.fil w] + + catch { + close [open testOpenFileChannel1%.fil r] + catch {close [open testOpenFileChannel2%.fil r]} + close [open testOpenFileChannel3%.fil r] + } err3 + + file delete __testOpenFileChannel1%__.fil + file delete __testOpenFileChannel3%__.fil + + set err3 +} {} + +test openfilechannel-1.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} { + # Next delete the 1st procedure and test that only the 3rd procedure + # is the only one that exists. + + testopenfilechannelproc delete TestOpenFileChannelProc1 + + close [open __testOpenFileChannel3%__.fil w] + + catch { + catch {close [open testOpenFileChannel1%.fil r]} + catch {close [open testOpenFileChannel2%.fil r]} + close [open testOpenFileChannel3%.fil r] + } err4 + + file delete __testOpenFileChannel3%__.fil + + set err4 +} {} + +test openfilechannel-1.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} { + # Finally delete the 3rd procedure and check that none of the + # procedures exist. + + testopenfilechannelproc delete TestOpenFileChannelProc3 + catch { + catch [open testOpenFileChannel1%.fil r] + catch [open testOpenFileChannel2%.fil r] + catch [open testOpenFileChannel3%.fil r] + } err5 + + set err5 +} {1} + +test openfilechannel-1.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} { + # Attempt to delete all the OpenFileChannel procs. again to ensure they no longer + # exist and an error is returned. + + catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9 + catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10 + catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11 + + list $err9 $err10 $err11 +} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} +} diff --git a/tests/join.test b/tests/join.test index 770f53a..0553f43 100644 --- a/tests/join.test +++ b/tests/join.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. # -# SCCS: @(#) join.test 1.8 97/12/08 15:03:20 +# RCS: @(#) $Id: join.test,v 1.1.2.2 1998/09/24 23:59:28 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/lindex.test b/tests/lindex.test index 46023ca..45d5f70 100644 --- a/tests/lindex.test +++ b/tests/lindex.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. # -# SCCS: @(#) lindex.test 1.8 97/12/08 15:03:23 +# RCS: @(#) $Id: lindex.test,v 1.1.2.2 1998/09/24 23:59:28 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/link.test b/tests/link.test index 4e405a0..df788cd 100644 --- a/tests/link.test +++ b/tests/link.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. # -# SCCS: @(#) link.test 1.14 98/02/18 11:59:28 +# RCS: @(#) $Id: link.test,v 1.1.2.2 1998/09/24 23:59:28 stanton Exp $ if {[info commands testlink] == {}} { puts "This application hasn't been compiled with the \"testlink\"" diff --git a/tests/linsert.test b/tests/linsert.test index 9111afb..3fe65d4 100644 --- a/tests/linsert.test +++ b/tests/linsert.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. # -# SCCS: @(#) linsert.test 1.15 97/12/08 15:03:29 +# RCS: @(#) $Id: linsert.test,v 1.1.2.2 1998/09/24 23:59:28 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/list.test b/tests/list.test index f2bd5e5..64819fb 100644 --- a/tests/list.test +++ b/tests/list.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. # -# SCCS: @(#) list.test 1.23 97/12/08 15:03:32 +# RCS: @(#) $Id: list.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/listObj.test b/tests/listObj.test index db4a7aa..e9c3e0c 100644 --- a/tests/listObj.test +++ b/tests/listObj.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. # -# SCCS: @(#) listObj.test 1.11 97/12/16 13:34:13 +# RCS: @(#) $Id: listObj.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" diff --git a/tests/llength.test b/tests/llength.test index 119c3da..27b1197 100644 --- a/tests/llength.test +++ b/tests/llength.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. # -# SCCS: @(#) llength.test 1.5 97/12/08 15:03:34 +# RCS: @(#) $Id: llength.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/load.test b/tests/load.test index 4e8d29c..ccf0fab 100644 --- a/tests/load.test +++ b/tests/load.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. # -# SCCS: @(#) load.test 1.22 98/02/11 19:45:38 +# RCS: @(#) $Id: load.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/lrange.test b/tests/lrange.test index 973c94e..b2beb53 100644 --- a/tests/lrange.test +++ b/tests/lrange.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. # -# SCCS: @(#) lrange.test 1.13 97/12/08 15:03:37 +# RCS: @(#) $Id: lrange.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/lreplace.test b/tests/lreplace.test index faca206..6fe4a00 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.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. # -# SCCS: @(#) lreplace.test 1.17 97/12/08 15:03:40 +# RCS: @(#) $Id: lreplace.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/lsearch.test b/tests/lsearch.test index d0a1ba2..8caf8d8 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.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. # -# SCCS: @(#) lsearch.test 1.8 97/12/08 15:03:42 +# RCS: @(#) $Id: lsearch.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/macFCmd.test b/tests/macFCmd.test index 5290d05..5edc69e 100644 --- a/tests/macFCmd.test +++ b/tests/macFCmd.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. # -# SCCS: @(#) macFCmd.test 1.4 97/12/08 15:06:36 +# RCS: @(#) $Id: macFCmd.test,v 1.1.2.2 1998/09/24 23:59:29 stanton Exp $ # if {$tcl_platform(platform) != "macintosh"} { diff --git a/tests/misc.test b/tests/misc.test index 5faa63e..d13a28f 100644 --- a/tests/misc.test +++ b/tests/misc.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. # -# SCCS: @(#) misc.test 1.14 97/12/16 13:34:35 +# RCS: @(#) $Id: misc.test,v 1.1.2.2 1998/09/24 23:59:30 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/namespace-old.test b/tests/namespace-old.test index df2c822..cd6a379 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) namespace-old.test 1.6 97/12/08 15:07:16 +# RCS: @(#) $Id: namespace-old.test,v 1.1.2.2 1998/09/24 23:59:30 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/namespace.test b/tests/namespace.test index 2c186e1..2d1f501 100644 --- a/tests/namespace.test +++ b/tests/namespace.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. # -# SCCS: @(#) namespace.test 1.18 97/12/16 13:34:44 +# RCS: @(#) $Id: namespace.test,v 1.1.2.2 1998/09/24 23:59:31 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -222,6 +222,23 @@ test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} { cmd1 555 } } {cmd1: 555} +test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} { + catch {eval namespace delete [namespace children :: test_ns_*]} + namespace eval test_ns_export { + namespace export cmd1 + proc cmd1 {args} {return "cmd1: $args"} + } + namespace eval test_ns_import { + namespace import -force ::test_ns_export::* + } + list [test_ns_import::cmd1 a b c] \ + [test_ns_export::cmd1 d e f] \ + [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \ + [namespace origin test_ns_import::cmd1] \ + [namespace origin test_ns_export::cmd1] \ + [test_ns_import::cmd1 g h i] \ + [test_ns_export::cmd1 j k l] +} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}} test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { catch {eval namespace delete [namespace children :: test_ns_*]} diff --git a/tests/obj.test b/tests/obj.test index 0a854af..5557150 100644 --- a/tests/obj.test +++ b/tests/obj.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. # -# @(#) obj.test 1.15 98/01/06 11:12:00 +# RCS: @(#) $Id: obj.test,v 1.1.2.2 1998/09/24 23:59:32 stanton Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" diff --git a/tests/opt.test b/tests/opt.test index 72efead..e669718 100644 --- a/tests/opt.test +++ b/tests/opt.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. # -# SCCS: @(#) opt.test 1.7 98/01/07 17:07:52 +# RCS: @(#) $Id: opt.test,v 1.1.2.2 1998/09/24 23:59:32 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -253,7 +253,6 @@ test opt-10.10 {medium size overall test} { list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0] } {1 {too many arguments (unexpected argument(s): foo), usage:}} - test opt-11.1 {too many args test 2} { set key [::tcl::OptKeyRegister {-foo}] list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\ @@ -263,9 +262,6 @@ test opt-11.1 {too many args test 2} { ------------ ---- ----- ---- ( -help gives this help ) -foo boolflag (false) } {}} - - - test opt-11.2 {default value for args} { set args {} set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}] diff --git a/tests/osa.test b/tests/osa.test index 3392128..c2e16bb 100644 --- a/tests/osa.test +++ b/tests/osa.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. # -# SCCS: @(#) osa.test 1.5 97/12/08 15:06:02 +# RCS: @(#) $Id: osa.test,v 1.1.2.2 1998/09/24 23:59:32 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/parse.test b/tests/parse.test index e14449d..ff61caa 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) parse.test 1.14 97/12/22 19:41:39 +# RCS: @(#) $Id: parse.test,v 1.1.2.2 1998/09/24 23:59:33 stanton Exp $ if {[info commands testparser] == {}} { puts "This application hasn't been compiled with the \"testparser\"" diff --git a/tests/pid.test b/tests/pid.test index 3b2f30b..323b12a 100644 --- a/tests/pid.test +++ b/tests/pid.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. # -# SCCS: @(#) pid.test 1.13 97/12/08 15:05:26 +# RCS: @(#) $Id: pid.test,v 1.1.2.2 1998/09/24 23:59:33 stanton Exp $ # If pid is not defined just return with no error # Some platforms may not have the pid command implemented diff --git a/tests/pkg.test b/tests/pkg.test index 63dc05c..22b2baa 100644 --- a/tests/pkg.test +++ b/tests/pkg.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. # -# SCCS: @(#) pkg.test 1.14 97/12/08 15:03:04 +# RCS: @(#) $Id: pkg.test,v 1.1.2.2 1998/09/24 23:59:34 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/proc-old.test b/tests/proc-old.test index 4eb956c..3a9bd43 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) proc-old.test 1.32 97/12/08 15:06:46 +# RCS: @(#) $Id: proc-old.test,v 1.1.2.2 1998/09/24 23:59:34 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/proc.test b/tests/proc.test index 7a0081a..17da4f7 100644 --- a/tests/proc.test +++ b/tests/proc.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. # -# SCCS: @(#) proc.test 1.12 97/12/08 15:03:59 +# RCS: @(#) $Id: proc.test,v 1.1.2.2 1998/09/24 23:59:34 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/pwd.test b/tests/pwd.test index e283799..8a11910 100644 --- a/tests/pwd.test +++ b/tests/pwd.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. # -# SCCS: @(#) pwd.test 1.2 97/08/13 23:06:41 +# RCS: @(#) $Id: pwd.test,v 1.1.2.1 1998/09/24 23:59:34 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/regexp.test b/tests/regexp.test index e39c96c..873ab4d 100644 --- a/tests/regexp.test +++ b/tests/regexp.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. # -# SCCS: @(#) regexp.test 1.27 98/01/28 18:07:48 +# RCS: @(#) $Id: regexp.test,v 1.1.2.2 1998/09/24 23:59:34 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/registry.test b/tests/registry.test index b1597d1..ffa2961 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -9,7 +9,7 @@ # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # -# SCCS: @(#) registry.test 1.9 98/01/05 16:18:05 +# RCS: @(#) $Id: registry.test,v 1.1.2.2 1998/09/24 23:59:34 stanton Exp $ if {$tcl_platform(platform) != "windows"} { return diff --git a/tests/remote.tcl b/tests/remote.tcl new file mode 100644 index 0000000..6fe72a8 --- /dev/null +++ b/tests/remote.tcl @@ -0,0 +1,161 @@ +# This file contains Tcl code to implement a remote server that can be +# used during testing of Tcl socket code. This server is used by some +# of the tests in socket.test. +# +# Source this file in the remote server you are using to test Tcl against. +# +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: remote.tcl,v 1.1.2.1 1998/09/24 23:59:35 stanton Exp $ + +# Initialize message delimitor + +# Initialize command array +catch {unset command} +set command(0) "" +set callerSocket "" + +# Detect whether we should print out connection messages etc. +if {![info exists VERBOSE]} { + set VERBOSE 0 +} + +proc __doCommands__ {l s} { + global callerSocket VERBOSE + + if {$VERBOSE} { + puts "--- Server executing the following for socket $s:" + puts $l + puts "---" + } + set callerSocket $s + if {[catch {uplevel #0 $l} msg]} { + list error $msg + } else { + list success $msg + } +} + +proc __readAndExecute__ {s} { + global command VERBOSE + + set l [gets $s] + if {[string compare $l "--Marker--Marker--Marker--"] == 0} { + if {[info exists command($s)]} { + puts $s [list error incomplete_command] + } + puts $s "--Marker--Marker--Marker--" + return + } + if {[string compare $l ""] == 0} { + if {[eof $s]} { + if {$VERBOSE} { + puts "Server closing $s, eof from client" + } + close $s + } + return + } + append command($s) $l "\n" + if {[info complete $command($s)]} { + set cmds $command($s) + unset command($s) + puts $s [__doCommands__ $cmds $s] + } + if {[eof $s]} { + if {$VERBOSE} { + puts "Server closing $s, eof from client" + } + close $s + } +} + +proc __accept__ {s a p} { + global VERBOSE + + if {$VERBOSE} { + puts "Server accepts new connection from $a:$p on $s" + } + fileevent $s readable [list __readAndExecute__ $s] + fconfigure $s -buffering line -translation crlf +} + +set serverIsSilent 0 +for {set i 0} {$i < $argc} {incr i} { + if {[string compare -serverIsSilent [lindex $argv $i]] == 0} { + set serverIsSilent 1 + break + } +} +if {![info exists serverPort]} { + if {[info exists env(serverPort)]} { + set serverPort $env(serverPort) + } +} +if {![info exists serverPort]} { + for {set i 0} {$i < $argc} {incr i} { + if {[string compare -port [lindex $argv $i]] == 0} { + if {$i < [expr $argc - 1]} { + set serverPort [lindex $argv [expr $i + 1]] + } + break + } + } +} +if {![info exists serverPort]} { + set serverPort 2048 +} + +if {![info exists serverAddress]} { + if {[info exists env(serverAddress)]} { + set serverAddress $env(serverAddress) + } +} +if {![info exists serverAddress]} { + for {set i 0} {$i < $argc} {incr i} { + if {[string compare -address [lindex $argv $i]] == 0} { + if {$i < [expr $argc - 1]} { + set serverAddress [lindex $argv [expr $i + 1]] + } + break + } + } +} +if {![info exists serverAddress]} { + set serverAddress 0.0.0.0 +} + +if {$serverIsSilent == 0} { + set l "Remote server listening on port $serverPort, IP $serverAddress." + puts "" + puts $l + for {set c [string length $l]} {$c > 0} {incr c -1} {puts -nonewline "-"} + puts "" + puts "" + puts "You have set the Tcl variables serverAddress to $serverAddress and" + puts "serverPort to $serverPort. You can set these with the -address and" + puts "-port command line options, or as environment variables in your" + puts "shell." + puts "" + puts "NOTE: The tests will not work properly if serverAddress is set to" + puts "\"localhost\" or 127.0.0.1." + puts "" + puts "When you invoke tcltest to run the tests, set the variables" + puts "remoteServerPort to $serverPort and remoteServerIP to" + puts "[info hostname]. You can set these as environment variables" + puts "from the shell. The tests will not work properly if you set" + puts "remoteServerIP to \"localhost\" or 127.0.0.1." + puts "" + puts -nonewline "Type Ctrl-C to terminate--> " + flush stdout +} + +if {[catch {set serverSocket \ + [socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} { + puts "Server on $serverAddress:$serverPort cannot start: $msg" +} else { + vwait __server_wait_variable__ +} diff --git a/tests/rename.test b/tests/rename.test index 0484108..6956cf0 100644 --- a/tests/rename.test +++ b/tests/rename.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. # -# SCCS: @(#) rename.test 1.21 97/12/08 15:04:05 +# RCS: @(#) $Id: rename.test,v 1.1.2.2 1998/09/24 23:59:35 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/resource.test b/tests/resource.test index e815ef8..840443c 100644 --- a/tests/resource.test +++ b/tests/resource.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. # -# SCCS: @(#) resource.test 1.8 97/11/06 12:36:32 +# RCS: @(#) $Id: resource.test,v 1.1.2.1 1998/09/24 23:59:35 stanton Exp $ # Only run this test on Macintosh systems if {$tcl_platform(platform) != "macintosh"} { diff --git a/tests/safe.test b/tests/safe.test index 36fcbd2..4ca857a 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. # -# SCCS: @(#) safe.test 1.35 97/12/08 15:06:30 +# RCS: @(#) $Id: safe.test,v 1.1.2.2 1998/09/24 23:59:35 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/scan.test b/tests/scan.test index c9e204c..e343742 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. # -# SCCS: @(#) scan.test 1.31 98/01/05 15:24:00 +# RCS: @(#) $Id: scan.test,v 1.1.2.2 1998/09/24 23:59:35 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/set-old.test b/tests/set-old.test index f77709b..78a5005 100644 --- a/tests/set-old.test +++ b/tests/set-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. # -# SCCS: @(#) set-old.test 1.25 97/12/16 13:35:36 +# RCS: @(#) $Id: set-old.test,v 1.1.2.2 1998/09/24 23:59:35 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -474,6 +474,29 @@ test set-old-8.37 {array command, set option} { array set aVaRnAmE {} list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg } {1 1 {can't read "aVaRnAmE": variable is array}} +test set-old-8.37.1 {array command, set scalar} { + catch {unset aVaRnAmE} + set aVaRnAmE 1 + list [catch {array set aVaRnAmE {}} msg] $msg +} {1 {can't array set "aVaRnAmE": variable isn't array}} +test set-old-8.37.2 {array command, set alias} { + catch {unset aVaRnAmE} + upvar 0 aVaRnAmE anAliAs + array set anAliAs {} + list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg +} {1 1 {can't read "anAliAs": variable is array}} +test set-old-8.37.3 {array command, set element alias} { + catch {unset aVaRnAmE} + list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \ + [catch {array set elemAliAs {}} msg] $msg +} {0 1 {can't array set "elemAliAs": variable isn't array}} +test set-old-8.37.4 {array command, empty set with populated array} { + catch {unset aVaRnAmE} + array set aVaRnAmE [list e1 v1 e2 v2] + array set aVaRnAmE {} + array set aVaRnAmE [list e3 v3] + list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg +} {{e1 e2 e3} 0 v2} test set-old-8.38 {array command, size option} { catch {unset a} array size a diff --git a/tests/set.test b/tests/set.test index 1b138d2..03c1492 100644 --- a/tests/set.test +++ b/tests/set.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. # -# SCCS: @(#) set.test 1.9 97/12/16 13:35:44 +# RCS: @(#) $Id: set.test,v 1.1.2.2 1998/09/24 23:59:36 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/socket.test b/tests/socket.test index 30a3746..67e6d46 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -59,7 +59,7 @@ # listening at port 2048. If all fails, a message is printed and the tests # using the remote server are not performed. # -# SCCS: @(#) socket.test 1.86 98/01/02 17:33:48 +# RCS: @(#) $Id: socket.test,v 1.1.2.2 1998/09/24 23:59:36 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -534,6 +534,34 @@ test socket-2.10 {close on accept, accepted socket lives} { after cancel $timer set done } 1 +test socket-2.11 {detecting new data} { + proc accept {s a p} { + global sock + set sock $s + } + + set s [socket -server accept 2400] + set sock "" + set s2 [socket localhost 2400] + vwait sock + puts $s2 one + flush $s2 + after 500 + fconfigure $sock -blocking 0 + set result [gets $sock] + lappend result [gets $sock] + fconfigure $sock -blocking 1 + puts $s2 two + flush $s2 + fconfigure $sock -blocking 0 + lappend result [gets $sock] + fconfigure $sock -blocking 1 + close $s2 + close $s + close $sock + set result +} {one {} two} + test socket-3.1 {socket conflict} {stdio} { removeFile script diff --git a/tests/source.test b/tests/source.test index c2ed57a..21c92f2 100644 --- a/tests/source.test +++ b/tests/source.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. # -# SCCS: @(#) source.test 1.30 98/01/05 16:17:37 +# RCS: @(#) $Id: source.test,v 1.1.2.2 1998/09/24 23:59:36 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/split.test b/tests/split.test index a57c714..d8a85bf 100644 --- a/tests/split.test +++ b/tests/split.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. # -# SCCS: @(#) split.test 1.10 97/07/07 16:30:07 +# RCS: @(#) $Id: split.test,v 1.1.2.1 1998/09/24 23:59:37 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/string.test b/tests/string.test index 6643d4f..5fd4352 100644 --- a/tests/string.test +++ b/tests/string.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. # -# SCCS: @(#) string.test 1.15 97/07/02 16:49:27 +# RCS: @(#) $Id: string.test,v 1.1.2.1 1998/09/24 23:59:37 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/stringObj.test b/tests/stringObj.test index a4efc8b..4d1e841 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.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. # -# @(#) stringObj.test 1.9 97/12/08 15:06:42 +# RCS: @(#) $Id: stringObj.test,v 1.1.2.2 1998/09/24 23:59:38 stanton Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" diff --git a/tests/subst.test b/tests/subst.test index 41afa48..fca58c4 100644 --- a/tests/subst.test +++ b/tests/subst.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. # -# SCCS: @(#) subst.test 1.10 97/12/08 15:04:29 +# RCS: @(#) $Id: subst.test,v 1.1.2.2 1998/09/24 23:59:38 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/switch.test b/tests/switch.test index d272836..cf5fec9 100644 --- a/tests/switch.test +++ b/tests/switch.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. # -# SCCS: @(#) switch.test 1.8 97/12/08 15:04:33 +# RCS: @(#) $Id: switch.test,v 1.1.2.2 1998/09/24 23:59:38 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/timer.test b/tests/timer.test index 1372ffa..0cb4f4d 100644 --- a/tests/timer.test +++ b/tests/timer.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. # -# SCCS: @(#) timer.test 1.4 97/12/08 15:06:49 +# RCS: @(#) $Id: timer.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/trace.test b/tests/trace.test index 3a80f08..84bb205 100644 --- a/tests/trace.test +++ b/tests/trace.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. # -# SCCS: @(#) trace.test 1.29 97/12/08 15:04:36 +# RCS: @(#) $Id: trace.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 2f3fe9e..b8c6711 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.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. # -# SCCS: @(#) unixFCmd.test 1.17 97/12/08 15:05:53 +# RCS: @(#) $Id: unixFCmd.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -91,7 +91,26 @@ test unixFCmd-1.7 {TclpRenameFile: EXDEV} { catch {file delete -force foo} set result } {1} - +test unixFCmd-1.8 {Checking EINTR Bug} nonPortable { + testalarm + after 2000 + list [testgotsig] [testgotsig] +} {1 0} +test unixFCmd-1.9 {Checking EINTR Bug} nonPortable { + cleanup + set f [open tfalarm w] + puts $f { + after 2000 + puts "hello world" + exit 0 + } + close $f + testalarm + set pipe [open "|[info nameofexecutable] tfalarm" r+] + set line [read $pipe 1] + catch {close $pipe} + list $line [testgotsig] +} {h 1} test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} { cleanup exec touch tf1 diff --git a/tests/unixFile.test b/tests/unixFile.test new file mode 100644 index 0000000..e94ed90 --- /dev/null +++ b/tests/unixFile.test @@ -0,0 +1,66 @@ +# This file contains tests for the routines in the file tclUnixFile.c +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# 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: unixFile.test,v 1.1.2.1 1998/09/24 23:59:39 stanton Exp $ + + +if {[string compare test [info procs test]] == 1} then {source defs} + +if {[info commands testobj] == {}} { + puts "This application hasn't been compiled with the \"testfindexecutable\"" + puts "command, so I can't test the Tcl_FindExecutable function" + return +} + +if {$tcl_platform(platform) != "unix"} { + return +} + + +set oldPath $env(PATH) +close [open junk w] +file attributes junk -perm 0777 + +set absPath [file join [pwd] junk] +test unixFile-1.1 {Tcl_FindExecutable} { + set env(PATH) "" + testfindexecutable junk +} $absPath +test unixFile-1.2 {Tcl_FindExecutable} { + set env(PATH) "/dummy" + testfindexecutable junk +} {} +test unixFile-1.3 {Tcl_FindExecutable} { + set env(PATH) "/dummy:[pwd]" + testfindexecutable junk +} $absPath +test unixFile-1.4 {Tcl_FindExecutable} { + set env(PATH) "/dummy:" + testfindexecutable junk +} $absPath +test unixFile-1.5 {Tcl_FindExecutable} { + set env(PATH) "/dummy:/dummy" + testfindexecutable junk +} {} +test unixFile-1.6 {Tcl_FindExecutable} { + set env(PATH) "/dummy::/dummy" + testfindexecutable junk +} $absPath +test unixFile-1.7 {Tcl_FindExecutable} { + set env(PATH) ":/dummy" + testfindexecutable junk +} $absPath + + + + +set env(PATH) $oldPath +file delete junk diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test index 262131f..da92085 100644 --- a/tests/unixNotfy.test +++ b/tests/unixNotfy.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. # -# SCCS: @(#) unixNotfy.test 1.7 98/02/17 23:45:12 +# RCS: @(#) $Id: unixNotfy.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -47,4 +47,5 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} { } {1 {can't wait for variable "x": would wait forever}} file delete foo +file delete foo2 return diff --git a/tests/unknown.test b/tests/unknown.test index 0fbc04a..ba9fc68 100644 --- a/tests/unknown.test +++ b/tests/unknown.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. # -# SCCS: @(#) unknown.test 1.13 97/12/08 15:04:40 +# RCS: @(#) $Id: unknown.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/uplevel.test b/tests/uplevel.test index 3aedf59..f9d11ce 100644 --- a/tests/uplevel.test +++ b/tests/uplevel.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. # -# SCCS: @(#) uplevel.test 1.14 97/12/08 15:04:43 +# RCS: @(#) $Id: uplevel.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/upvar.test b/tests/upvar.test index 8b556d9..cc934cd 100644 --- a/tests/upvar.test +++ b/tests/upvar.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. # -# SCCS: @(#) upvar.test 1.16 97/12/08 15:04:46 +# RCS: @(#) $Id: upvar.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -327,6 +327,11 @@ test upvar-8.9 {upvar won't create namespace variable that refers to procedure v } list [catch {MakeLink 1} msg] $msg } {1 {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}} +test upvar-8.10 {upvar will create element alias for new array element} { + catch {unset upvarArray} + array set upvarArray {} + catch {upvar 0 upvarArray(elem) upvarArrayElemAlias} +} {0} if {[info commands testupvar] != {}} { test upvar-9.1 {Tcl_UpVar2 procedure} { diff --git a/tests/util.test b/tests/util.test index c24ada7..bf29134 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. # -# SCCS: @(#) util.test 1.13 98/01/16 23:30:07 +# RCS: @(#) $Id: util.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" diff --git a/tests/var.test b/tests/var.test index 9c10ed7..f90a4f2 100644 --- a/tests/var.test +++ b/tests/var.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) var.test 1.12 98/02/05 20:22:48 +# RCS: @(#) $Id: var.test,v 1.1.2.2 1998/09/24 23:59:39 stanton Exp $ # if {[string compare test [info procs test]] == 1} then {source defs} @@ -407,6 +407,10 @@ test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var list [unset test_ns_var::v] $test_ns_var::info } {{} {test_ns_var::v {} u}} +if {[info commands testsetnoerr] == {}} { + puts "This application hasn't been compiled with the \"testsetnoerr\"" + puts "command, so I can't test TclSetVar etc." +} else { test var-9.1 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} { testsetnoerr v 1 } 1 diff --git a/tests/while-old.test b/tests/while-old.test index 478aac9..49d849c 100644 --- a/tests/while-old.test +++ b/tests/while-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. # -# SCCS: @(#) while-old.test 1.15 97/12/08 15:06:17 +# RCS: @(#) $Id: while-old.test,v 1.1.2.2 1998/09/24 23:59:40 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/while.test b/tests/while.test index 8eba9bd..e9a0ba6 100644 --- a/tests/while.test +++ b/tests/while.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. # -# SCCS: @(#) @(#) while.test 1.12 97/12/16 13:36:19 +# RCS: @(#) $Id: while.test,v 1.1.2.2 1998/09/24 23:59:40 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 651ffc0..5f1477a 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.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. # -# SCCS: @(#) winFCmd.test 1.17 98/02/11 17:37:01 +# RCS: @(#) $Id: winFCmd.test,v 1.1.2.2 1998/09/24 23:59:40 stanton Exp $ # if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/winNotify.test b/tests/winNotify.test index 2ae6b94..28429f9 100644 --- a/tests/winNotify.test +++ b/tests/winNotify.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. # -# SCCS: @(#) winNotify.test 1.3 97/12/08 15:06:52 +# RCS: @(#) $Id: winNotify.test,v 1.1.2.2 1998/09/24 23:59:40 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} diff --git a/tests/winPipe.test b/tests/winPipe.test index a732343..f8d0192 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.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. # -# SCCS: @(#) winPipe.test 1.15 97/12/22 18:13:59 +# RCS: @(#) $Id: winPipe.test,v 1.1.2.2 1998/09/24 23:59:40 stanton Exp $ if {($tcl_platform(platform) != "windows") || ($testConfig(stdio) == 0)} { return @@ -366,6 +366,17 @@ test winpipe-5.2 {PipeSetupProc & PipeCheckProc: write threads} { } +makeFile { + puts "[list $argv0 $argv]" +} echoArgs.tcl + +test winpipe-4.1 {BuildCommandLine: null arguments} { + exec $tcltest echoArgs.tcl foo "" bar +} {echoArgs.tcl {foo {} bar}} +test winpipe-4.1 {BuildCommandLine: null arguments} { + exec $tcltest echoArgs.tcl foo \" bar +} {echoArgs.tcl {foo {"} bar}} + # restore old values for env(TMP) and env(TEMP) if {[catch {set env(TMP) $env_tmp}]} { @@ -375,5 +386,5 @@ if {[catch {set env(TEMP) $env_temp}]} { unset env(TEMP) } -file delete big little stdout stderr nothing cat +file delete big little stdout stderr nothing return |