From 77286202dda7f636e31cc4623108de8b7471c25b Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Thu, 12 Sep 2019 19:12:56 +0000
Subject: windows: eliminate overwriting of WINDIR env-variable in makefiles
 (used WIN_DIR now similar to "makefile.in"); init.tcl: windows helper prefer
 SystemRoot if available.

---
 library/init.tcl |  4 +++-
 win/makefile.bc  | 26 ++++++++++++------------
 win/makefile.vc  | 60 ++++++++++++++++++++++++++++----------------------------
 3 files changed, 46 insertions(+), 44 deletions(-)

diff --git a/library/init.tcl b/library/init.tcl
index aaf148b..eb6b04e 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -680,7 +680,9 @@ proc auto_execok name {
     }
 
     set path "[file dirname [info nameof]];.;"
-    if {[info exists env(WINDIR)]} {
+    if {[info exists env(SystemRoot)]} {
+	set windir $env(SystemRoot)
+    } elseif {[info exists env(WINDIR)]} {
 	set windir $env(WINDIR)
     }
     if {[info exists windir]} {
diff --git a/win/makefile.bc b/win/makefile.bc
index 8f337e3..7881e2c 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -271,10 +271,10 @@ TCLOBJS	= \
 
 TCLSTUBOBJS	= $(TMPDIR)\tclStubLib.obj
 
-WINDIR		= $(ROOT)\win
+WIN_DIR		= $(ROOT)\win
 GENERICDIR	= $(ROOT)\generic
 
-TCL_INCLUDES	= -I"$(WINDIR)" -I"$(GENERICDIR)"
+TCL_INCLUDES	= -I"$(WIN_DIR)" -I"$(GENERICDIR)"
 TCL_DEFINES	= $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \
 			$(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \
 			-DTCL_CFGVAL_ENCODING=${CFG_ENCODING}
@@ -379,8 +379,8 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
 		$(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
 !
 
-$(TCLPIPEDLL): $(WINDIR)\stub16.c
-	$(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c
+$(TCLPIPEDLL): $(WIN_DIR)\stub16.c
+	$(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WIN_DIR)\stub16.c
 	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
 		$(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
 
@@ -394,7 +394,7 @@ $(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
 		$(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
 		$(TMPDIR)\$(NAMEPREFIX).res
 
-$(CAT32): $(WINDIR)\cat.c
+$(CAT32): $(WIN_DIR)\cat.c
 	$(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
 	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
 		$(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
@@ -499,10 +499,10 @@ $(TCLRTF): $(MAN2TCL).exe $(TCLSH)
 #
 # Special case object file targets
 #
-$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
+$(TMPDIR)\tclWinInit.obj: $(WIN_DIR)\tclWinInit.c
 	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
 
-$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+$(TMPDIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c
 	$(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?
 
 $(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
@@ -511,7 +511,7 @@ $(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
 $(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
 	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
 
-$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+$(TMPDIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
 	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
 
 $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
@@ -522,17 +522,17 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
 		-DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\"		\
 	 -o$(TMPDIR)\$@ $?
 
-$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
+$(TMPDIR)\tclAppInit.obj : $(WIN_DIR)\tclAppInit.c
 	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
 
 # The following objects should be built using the stub interfaces
 
 # tclWinReg: Produces errors in ANSI mode
-$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
+$(TMPDIR)\tclWinReg.obj : $(WIN_DIR)\tclWinReg.c
 	$(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
 
 # tclWinDde: Produces errors in ANSI mode
-$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
+$(TMPDIR)\tclWinDde.obj : $(WIN_DIR)\tclWinDde.c
 	$(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
 
 
@@ -571,7 +571,7 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
 # Implicit rules
 #
 
-{$(WINDIR)}.c{$(TMPDIR)}.obj:
+{$(WIN_DIR)}.c{$(TMPDIR)}.obj:
 	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
 
 {$(GENERICDIR)}.c{$(TMPDIR)}.obj:
@@ -580,7 +580,7 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
 {$(ROOT)\compat}.c{$(TMPDIR)}.obj:
 	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
 
-{$(WINDIR)}.rc{$(TMPDIR)}.res:
+{$(WIN_DIR)}.rc{$(TMPDIR)}.res:
 	$(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
 
 clean:
diff --git a/win/makefile.vc b/win/makefile.vc
index fc6191f..e2ec8ab 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -413,7 +413,7 @@ DOCDIR		= $(ROOT)\doc
 GENERICDIR	= $(ROOT)\generic
 TOMMATHDIR	= $(ROOT)\libtommath
 TOOLSDIR	= $(ROOT)\tools
-WINDIR		= $(ROOT)\win
+WIN_DIR		= $(ROOT)\win
 
 #---------------------------------------------------------------------
 # Compile flags
@@ -454,7 +454,7 @@ crt = -MT
 !endif
 !endif
 
-TCL_INCLUDES	= -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
+TCL_INCLUDES	= -I"$(WIN_DIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
 TCL_DEFINES	= -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline
 BASE_CFLAGS	= $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
 CON_CFLAGS	= $(cflags) $(cdebug) $(crt) -DCONSOLE
@@ -574,7 +574,7 @@ $(TCLLIB): $(TCLOBJS)
 $**
 <<
 !else
-	$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
+	$(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tcl -out:$@ \
 		$(baselibs) @<<
 $**
 <<
@@ -593,8 +593,8 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
 	$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
 	$(_VC_MANIFEST_EMBED_EXE)
 
-$(TCLPIPEDLL): $(WINDIR)\stub16.c
-	$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c
+$(TCLPIPEDLL): $(WIN_DIR)\stub16.c
+	$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WIN_DIR)\stub16.c
 	$(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs)
 	$(_VC_MANIFEST_EMBED_DLL)
 
@@ -603,7 +603,7 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
 	$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
 !else
 $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
-	$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
+	$(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tcldde -out:$@ \
 		$** $(baselibs)
 	$(_VC_MANIFEST_EMBED_DLL)
 	-@del $*.exp
@@ -615,14 +615,14 @@ $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
 	$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
 !else
 $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
-	$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
+	$(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tclreg -out:$@ \
 		$** $(baselibs)
 	$(_VC_MANIFEST_EMBED_DLL)
 	-@del $*.exp
 	-@del $*.lib
 !endif
 
-$(CAT32): $(WINDIR)\cat.c
+$(CAT32): $(WIN_DIR)\cat.c
 	$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
 	$(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
 		$(baselibs)
@@ -774,7 +774,7 @@ install-docs:
 
 tclConfig: $(OUT_DIR)\tclConfig.sh
 
-$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
+$(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
 	@echo Creating tclConfig.sh
         @nmakehlp -s << $** >$@
 @TCL_DLL_FILE@       $(TCLLIBNAME)
@@ -849,7 +849,7 @@ gendate:
 # Special case object file targets
 #---------------------------------------------------------------------
 
-$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+$(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c
 	$(cc32) $(TCL_CFLAGS) -DTCL_TEST \
 	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
 	    -Fo$@ $?
@@ -860,7 +860,7 @@ $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
 $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
 	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
 
-$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
 	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
 
 $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
@@ -877,7 +877,7 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
 	-DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""     \
 	-Fo$@ $?
 
-$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
+$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
 	$(cc32) $(TCL_CFLAGS) \
 	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
 	    -Fo$@ $?
@@ -885,7 +885,7 @@ $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
 ### The following objects should be built using the stub interfaces
 ### *ALL* extensions need to built with -DTCL_THREADS=1
 
-$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
+$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
 !if $(STATIC_BUILD)
 	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $?
 !else
@@ -893,7 +893,7 @@ $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
 !endif
 
 
-$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
+$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
 !if $(STATIC_BUILD)
 	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $?
 !else
@@ -908,7 +908,7 @@ $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
 $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
 	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
 
-$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
+$(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in
 	@nmakehlp -s << $** >$@
 @MACHINE@	  $(MACHINE:IX86=X86)
 @TCL_WIN_VERSION@  $(DOTVERSION).0.0
@@ -928,7 +928,7 @@ depend:
 !else
 	$(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
 		-passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
-		$(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
+		$(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<<
 $(TCLOBJS)
 <<
 !endif
@@ -952,7 +952,7 @@ $(TCLOBJS)
 # Implicit rules
 #---------------------------------------------------------------------
 
-{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+{$(WIN_DIR)}.c{$(TMP_DIR)}.obj::
 	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
 $<
 <<
@@ -972,7 +972,7 @@ $<
 $<
 <<
 
-{$(WINDIR)}.rc{$(TMP_DIR)}.res:
+{$(WIN_DIR)}.rc{$(TMP_DIR)}.res:
 	$(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
 	    -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
 	    -d TCL_THREADS=$(TCL_THREADS) \
@@ -1122,18 +1122,18 @@ tidy:
 clean:
 	@echo Cleaning $(TMP_DIR)\* ...
 	@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
-	@echo Cleaning $(WINDIR)\nmakehlp.obj ...
-	@if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
-	@echo Cleaning $(WINDIR)\nmakehlp.exe ...
-	@if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
-	@echo Cleaning $(WINDIR)\_junk.pch ...
-	@if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
-	@echo Cleaning $(WINDIR)\vercl.x ...
-	@if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
-	@echo Cleaning $(WINDIR)\vercl.i ...
-	@if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
-	@echo Cleaning $(WINDIR)\versions.vc ...
-	@if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+	@echo Cleaning $(WIN_DIR)\nmakehlp.obj ...
+	@if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj
+	@echo Cleaning $(WIN_DIR)\nmakehlp.exe ...
+	@if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe
+	@echo Cleaning $(WIN_DIR)\_junk.pch ...
+	@if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch
+	@echo Cleaning $(WIN_DIR)\vercl.x ...
+	@if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x
+	@echo Cleaning $(WIN_DIR)\vercl.i ...
+	@if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i
+	@echo Cleaning $(WIN_DIR)\versions.vc ...
+	@if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc
 
 realclean: hose
 
-- 
cgit v0.12


From 3b982165aff1858cc7a0a4ea123cd74d3704f872 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Thu, 12 Sep 2019 19:34:23 +0000
Subject: cmdAH.test (win-only): rewrite test to prefer SystemRoot (readonly)
 instead of windir to check windows directory is not owned, bug [7de2d722bd]

---
 tests/cmdAH.test | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index b60f658..0f3ca7c 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1349,8 +1349,12 @@ test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
 test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
     file owned /
 } 0
-test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win knownMsvcBug} -body {
-    file owned $env(windir)
+test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body {
+    if {[info exists env(SystemRoot)]} {
+	file owned $env(SystemRoot)
+    } else {
+	file owned $env(windir)
+    }
 } -result 0
 test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
     file owned nosuchfile
-- 
cgit v0.12


From 794b9c5949eb0c88fde85361818d0246a9e3235e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 13 Sep 2019 07:55:30 +0000
Subject: Remove unneeded knownMsvcBug testconstraint definition

---
 tests/cmdAH.test | 1 -
 win/makefile.vc  | 2 +-
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 0f3ca7c..f19e11a 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -30,7 +30,6 @@ testConstraint linkDirectory [expr {
     ($::tcl_platform(osVersion) >= 5.0
      && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
 }]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
 
 global env
 set cmdAHwd [pwd]
diff --git a/win/makefile.vc b/win/makefile.vc
index 04dcbcb..8f74e79 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -480,11 +480,11 @@ $(TCLLIB): $(TCLOBJS)
 $**
 <<
 	$(_VC_MANIFEST_EMBED_DLL)
+
 $(TCLIMPLIB): $(TCLLIB)
 
 !endif # $(STATIC_BUILD)
 
-
 $(TCLSTUBLIB): $(TCLSTUBOBJS)
 	$(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)
 
-- 
cgit v0.12


From 98e3a60b678a4788e86ecda69c4e6374ccb9de40 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 13 Sep 2019 09:01:44 +0000
Subject: Add knownMsvcBug restriction to chanio-20.5, because it sometimes
 hangs in a Travis build. Restucture many test-cases to tcltest 2 syntax.

---
 tests/chanio.test | 399 ++++++++++++++++++++++++------------------------------
 1 file changed, 178 insertions(+), 221 deletions(-)

diff --git a/tests/chanio.test b/tests/chanio.test
index a18bbbe..5fae431 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -92,6 +92,11 @@ namespace eval ::tcl::test::io {
 	return $a
     }
 
+    # Wrapper round butt-ugly pipe syntax
+    proc openpipe {{mode r+} args} {
+	open "|[list [interpreter] {*}$args]" $mode
+    }
+
 test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
     # no test, need to cause an async error.
 } {}
@@ -114,80 +119,58 @@ set path(test2) [makeFile {} test2]
 test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
     # This test written for SF bug #506297.
     #
-    # Executing this test without the fix for the referenced bug
-    # applied to tcl will cause tcl, more specifically WriteChars, to
-    # go into an infinite loop.
-
+    # Executing this test without the fix for the referenced bug applied to
+    # tcl will cause tcl, more specifically WriteChars, to go into an infinite
+    # loop.
     set f [open $path(test2) w]
     chan configure      $f -encoding iso2022-jp
     chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
     chan close           $f
     contents $path(test2)
 } "    \x1b\$B\$O\x1b(B"
-
 test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
-    # When closing a channel with an encoding that appends
-    # escape bytes, check for the case where the escape
-    # bytes overflow the current IO buffer. The bytes
-    # should be moved into a new buffer.
-
+    # When closing a channel with an encoding that appends escape bytes, check
+    # for the case where the escape bytes overflow the current IO buffer. The
+    # bytes should be moved into a new buffer.
     set data "1234567890 [format %c 12399]"
-
     set sizes [list]
-
     # With default buffer size
     set f [open $path(test2) w]
     chan configure      $f -encoding iso2022-jp
     chan puts -nonewline $f $data
     chan close           $f
     lappend sizes [file size $path(test2)]
-
-    # With buffer size equal to the length
-    # of the data, the escape bytes would
+    # With buffer size equal to the length of the data, the escape bytes would
     # go into the next buffer.
-
     set f [open $path(test2) w]
     chan configure      $f -encoding iso2022-jp -buffersize 16
     chan puts -nonewline $f $data
     chan close           $f
     lappend sizes [file size $path(test2)]
-
-    # With buffer size that is large enough
-    # to hold 1 byte of escaped data, but
-    # not all 3. This should not write
-    # the escape bytes to the first buffer
-    # and then again to the second buffer.
-
+    # With buffer size that is large enough to hold 1 byte of escaped data,
+    # but not all 3. This should not write the escape bytes to the first
+    # buffer and then again to the second buffer.
     set f [open $path(test2) w]
     chan configure      $f -encoding iso2022-jp -buffersize 17
     chan puts -nonewline $f $data
     chan close           $f
     lappend sizes [file size $path(test2)]
-
-    # With buffer size that can hold 2 out of
-    # 3 bytes of escaped data.
-
+    # With buffer size that can hold 2 out of 3 bytes of escaped data.
     set f [open $path(test2) w]
     chan configure      $f -encoding iso2022-jp -buffersize 18
     chan puts -nonewline $f $data
     chan close           $f
     lappend sizes [file size $path(test2)]
-
-    # With buffer size that can hold all the
-    # data and escape bytes.
-
+    # With buffer size that can hold all the data and escape bytes.
     set f [open $path(test2) w]
     chan configure      $f -encoding iso2022-jp -buffersize 19
     chan puts -nonewline $f $data
     chan close           $f
     lappend sizes [file size $path(test2)]
-
-    set sizes
 } {19 19 19 19 19}
 
 test chan-io-2.1 {WriteBytes} {
     # loop until all bytes are written
-
     set f [open $path(test1) w]
     chan configure $f  -encoding binary -buffersize 16 -translation crlf
     chan puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -197,7 +180,6 @@ test chan-io-2.1 {WriteBytes} {
 test chan-io-2.2 {WriteBytes: savedLF > 0} {
     # After flushing buffer, there was a \n left over from the last
     # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.
-
     set f [open $path(test1) w]
     chan configure $f -encoding binary -buffersize 16 -translation crlf
     chan puts -nonewline $f "123456789012345\n12"
@@ -205,18 +187,17 @@ test chan-io-2.2 {WriteBytes: savedLF > 0} {
     chan close $f
     lappend x [contents $path(test1)]
 } [list "123456789012345\r" "123456789012345\r\n12"]
-test chan-io-2.3 {WriteBytes: flush on line} {
-    # Tcl "line" buffering has weird behavior: if current buffer contains
-    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
-    # only up to the \n.
-
+test chan-io-2.3 {WriteBytes: flush on line} -body {
+    # Tcl "line" buffering has weird behavior: if current buffer contains a
+    # \n, entire buffer gets flushed.  Logical behavior would be to flush only
+    # up to the \n.
     set f [open $path(test1) w]
     chan configure $f -encoding binary -buffering line -translation crlf
     chan puts -nonewline $f "\n12"
-    set x [contents $path(test1)]
+    contents $path(test1)
+} -cleanup {
     chan close $f
-    set x
-} "\r\n12"
+} -result "\r\n12"
 test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} {
     set f [open $path(test1) w]
      chan configure $f -encoding binary -buffering line -translation lf \
@@ -229,7 +210,6 @@ test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} {
 
 test chan-io-3.1 {WriteChars: compatibility with WriteBytes} {
     # loop until all bytes are written
-
     set f [open $path(test1) w]
     chan configure $f -encoding ascii -buffersize 16 -translation crlf
     chan puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -239,7 +219,6 @@ test chan-io-3.1 {WriteChars: compatibility with WriteBytes} {
 test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
     # After flushing buffer, there was a \n left over from the last
     # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.
-
     set f [open $path(test1) w]
     chan configure $f -encoding ascii -buffersize 16 -translation crlf
     chan puts -nonewline $f "123456789012345\n12"
@@ -247,21 +226,19 @@ test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
     chan close $f
     lappend x [contents $path(test1)]
 } [list "123456789012345\r" "123456789012345\r\n12"]
-test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
-    # Tcl "line" buffering has weird behavior: if current buffer contains
-    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
-    # only up to the \n.
-
+test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -body {
+    # Tcl "line" buffering has weird behavior: if current buffer contains a
+    # \n, entire buffer gets flushed.  Logical behavior would be to flush only
+    # up to the \n.
     set f [open $path(test1) w]
     chan configure $f -encoding ascii -buffering line -translation crlf
     chan puts -nonewline $f "\n12"
-    set x [contents $path(test1)]
+    contents $path(test1)
+} -cleanup {
     chan close $f
-    set x
-} "\r\n12"
+} -result "\r\n12"
 test chan-io-3.4 {WriteChars: loop over stage buffer} {
     # stage buffer maps to more than can be queued at once.
-
     set f [open $path(test1) w]
     chan configure $f -encoding jis0208 -buffersize 16
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
@@ -270,10 +247,9 @@ test chan-io-3.4 {WriteChars: loop over stage buffer} {
     lappend x [contents $path(test1)]
 } [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
 test chan-io-3.5 {WriteChars: saved != 0} {
-    # Bytes produced by UtfToExternal from end of last channel buffer
-    # had to be moved to beginning of next channel buffer to preserve
-    # requested buffersize.
-
+    # Bytes produced by UtfToExternal from end of last channel buffer had to
+    # be moved to beginning of next channel buffer to preserve requested
+    # buffersize.
     set f [open $path(test1) w]
     chan configure $f -encoding jis0208 -buffersize 17
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
@@ -282,15 +258,14 @@ test chan-io-3.5 {WriteChars: saved != 0} {
     lappend x [contents $path(test1)]
 } [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
 test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
-    # One incomplete UTF-8 character at end of staging buffer.  Backup
-    # in src to the beginning of that UTF-8 character and try again.
+    # One incomplete UTF-8 character at end of staging buffer. Backup in src
+    # to the beginning of that UTF-8 character and try again.
     #
     # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
-    # (first two bytes of \uff21 in UTF-8).  Given those two bytes try
+    # (first two bytes of \uff21 in UTF-8). Given those two bytes try
     # translating them again, find that no bytes are read produced, and break
-    # to outer loop where those two bytes will have the remaining 4 bytes
-    # (the last byte of \uff21 plus the all of \uff22) appended.
-
+    # to outer loop where those two bytes will have the remaining 4 bytes (the
+    # last byte of \uff21 plus the all of \uff22) appended.
     set f [open $path(test1) w]
     chan configure $f -encoding shiftjis -buffersize 16
     chan puts -nonewline $f "12345678901234\uff21\uff22"
@@ -299,12 +274,11 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
     lappend x [contents $path(test1)]
 } [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
 test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
-    # When translating UTF-8 to external, the produced bytes went past end
-    # of the channel buffer.  This is done purpose -- we then truncate the
-    # bytes at the end of the partial character to preserve the requested
-    # blocksize on flush.  The truncated bytes are moved to the beginning
-    # of the next channel buffer.
-
+    # When translating UTF-8 to external, the produced bytes went past end of
+    # the channel buffer. This is done on purpose - we then truncate the bytes
+    # at the end of the partial character to preserve the requested blocksize
+    # on flush. The truncated bytes are moved to the beginning of the next
+    # channel buffer.
     set f [open $path(test1) w]
     chan configure $f -encoding jis0208 -buffersize 17
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
@@ -324,7 +298,6 @@ test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
 
 test chan-io-4.1 {TranslateOutputEOL: lf} {
     # search for \n
-
     set f [open $path(test1) w]
     chan configure $f -buffering line -translation lf
     chan puts $f "abcde"
@@ -334,7 +307,6 @@ test chan-io-4.1 {TranslateOutputEOL: lf} {
 } [list "abcde\n" "abcde\n"]
 test chan-io-4.2 {TranslateOutputEOL: cr} {
     # search for \n, replace with \r
-
     set f [open $path(test1) w]
     chan configure $f -buffering line -translation cr
     chan puts $f "abcde"
@@ -344,7 +316,6 @@ test chan-io-4.2 {TranslateOutputEOL: cr} {
 } [list "abcde\r" "abcde\r"]
 test chan-io-4.3 {TranslateOutputEOL: crlf} {
     # simple case: search for \n, replace with \r
-
     set f [open $path(test1) w]
     chan configure $f -buffering line -translation crlf
     chan puts $f "abcde"
@@ -353,10 +324,9 @@ test chan-io-4.3 {TranslateOutputEOL: crlf} {
     lappend x [contents $path(test1)]
 } [list "abcde\r\n" "abcde\r\n"]
 test chan-io-4.4 {TranslateOutputEOL: crlf} {
-    # keep storing more bytes in output buffer until output buffer is full.
-    # We have 13 bytes initially that would turn into 18 bytes.  Fill
-    # dest buffer while (dstEnd < dstMax).
-
+    # Keep storing more bytes in output buffer until output buffer is full. We
+    # have 13 bytes initially that would turn into 18 bytes. Fill dest buffer
+    # while (dstEnd < dstMax).
     set f [open $path(test1) w]
     chan configure $f -translation crlf -buffersize 16
     chan puts -nonewline $f "1234567\n\n\n\n\nA"
@@ -366,7 +336,6 @@ test chan-io-4.4 {TranslateOutputEOL: crlf} {
 } [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]
 test chan-io-4.5 {TranslateOutputEOL: crlf} {
     # Check for overflow of the destination buffer
-
     set f [open $path(test1) w]
     chan configure $f -translation crlf -buffersize 12
     chan puts -nonewline $f "12345678901\n456789012345678901234"
@@ -415,109 +384,106 @@ test chan-io-5.5 {CheckFlush: none} {
     lappend x [contents $path(test1)]
 } [list "1234567890" "1234567890"]
 
-test chan-io-6.1 {Tcl_GetsObj: working} {
+test chan-io-6.1 {Tcl_GetsObj: working} -body {
     set f [open $path(test1) w]
     chan puts $f "foo\nboo"
     chan close $f
     set f [open $path(test1)]
-    set x [chan gets $f]
+    chan gets $f
+} -cleanup {
     chan close $f
-    set x
-} {foo}
+} -result {foo}
 test chan-io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest {
     # no test, need to cause an async error.
 } {}
-test chan-io-6.3 {Tcl_GetsObj: how many have we used?} {
+test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body {
     # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}
-
     set f [open $path(test1) w]
     chan configure $f -translation crlf
     chan puts $f "abc\ndefg"
     chan close $f
     set f [open $path(test1)]
-    set x [list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line]
+    list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} {0 3 5 4 defg}
-test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} {
+} -result {0 3 5 4 defg}
+test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
     set f [open $path(test1) w]
     chan configure $f -translation binary
     chan puts $f "\x81\u1234\0"
     chan close $f
     set f [open $path(test1)]
     chan configure $f -translation binary
-    set x [list [chan gets $f line] $line]
+    list [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} [list 3 "\x81\x34\x00"]
-test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} {
+} -result [list 3 "\x81\x34\x00"]
+test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body {
     set f [open $path(test1) w]
     chan configure $f -translation binary
     chan puts $f "\x88\xea\x92\x9a"
     chan close $f
     set f [open $path(test1)]
     chan configure $f -encoding shiftjis
-    set x [list [chan gets $f line] $line]
+    list [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} [list 2 "\u4e00\u4e01"]
+} -result [list 2 "\u4e00\u4e01"]
 set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
 append a $a
 append a $a
-test chan-io-6.6 {Tcl_GetsObj: loop test} {
-    # if (dst >= dstEnd)
-
+test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
+    # if (dst >= dstEnd) 
     set f [open $path(test1) w]
     chan puts $f $a
     chan puts $f hi
     chan close $f
     set f [open $path(test1)]
-    set x [list [chan gets $f line] $line]
+    list [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} [list 256 $a]
-test chan-io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
+} -result [list 256 $a]
+test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
     # if (FilterInputBytes(chanPtr, &gs) != 0)
-
-    set f [open "|[list [interpreter] $path(cat)]" w+]
+    set f [openpipe w+ $path(cat)]
     chan puts -nonewline $f "hi\nwould"
     chan flush $f
     chan gets $f
     chan configure $f -blocking 0
-    set x [chan gets $f line]
+    chan gets $f line
+} -cleanup {
     chan close $f
-    set x
-} {-1}
-test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
+} -result {-1}
+test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
     set f [open $path(test1) w]
     chan puts $f "abcdef\x1aghijk\nwombat"
     chan close $f
     set f [open $path(test1)]
     chan configure $f -eofchar \x1a
-    set x [list [chan gets $f line] $line [chan gets $f line] $line]
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} {6 abcdef -1 {}}
-test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
+} -result {6 abcdef -1 {}}
+test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body {
     set f [open $path(test1) w]
     chan puts $f "abcdefghijk\nwom\u001abat"
     chan close $f
     set f [open $path(test1)]
     chan configure $f -eofchar \x1a
-    set x [list [chan gets $f line] $line [chan gets $f line] $line]
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} {11 abcdefghijk 3 wom}
+} -result {11 abcdefghijk 3 wom}
 # Comprehensive tests
-test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} {
+test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} -body {
     set f [open $path(test1) w]
     chan close $f
     set f [open $path(test1)]
     chan configure $f -translation lf
-    set x [list [chan gets $f line] $line]
+    list [chan gets $f line] $line
+} -cleanup {
     chan close $f
-    set x
-} {-1 {}}
+} -result {-1 {}}
 test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
     set f [open $path(test1) w]
     chan configure $f -translation lf
@@ -1911,31 +1877,33 @@ test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel
 	[list 0 [format "can not find channel named \"%s\"" $f]]
 } 0
 
-test chan-io-20.1 {Tcl_CreateChannel: initial settings} {
-	set a [open $path(test2) w]
+test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup {
     set old [encoding system]
+} -body {
+    set a [open $path(test2) w]
     encoding system ascii
     set f [open $path(test1) w]
-    set x [chan configure $f -encoding]
-    chan close $f
+    chan configure $f -encoding
+} -cleanup {
     encoding system $old
-	chan close $a
-    set x
-} {ascii}
-test chan-io-20.2 {Tcl_CreateChannel: initial settings} {win} {
+    chan close $f
+    chan close $a
+} -result {ascii}
+test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
     set f [open $path(test1) w+]
-    set x [list [chan configure $f -eofchar] [chan configure $f -translation]]
+    list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
     chan close $f
-    set x
-} [list [list \x1a ""] {auto crlf}]
-test chan-io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
+} -result [list [list \x1a ""] {auto crlf}]
+test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
     set f [open $path(test1) w+]
-    set x [list [chan configure $f -eofchar] [chan configure $f -translation]]
+    list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
     chan close $f
-    set x
-} {{{} {}} {auto lf}}
-set path(stdout) [makeFile {} stdout]
-test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
+} -result {{{} {}} {auto lf}}
+test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
+    set path(stdout) [makeFile {} stdout]
+} -constraints {stdio openpipe knownMsvcBug} -body {
     set f [open $path(script) w]
     chan puts -nonewline $f {
 	chan close stdout
@@ -1946,19 +1914,20 @@ test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio open
 	chan puts stderr [chan configure stdout -buffersize]
     }
     chan close $f
-    set f [open "|[list [interpreter] $path(script)]"]
-    catch {chan close $f} msg
-    set msg
-} {777}
+    set f [openpipe r $path(script)]
+    chan close $f
+} -cleanup {
+    removeFile $path(stdout)
+} -returnCodes error -result {777}
 
 test chan-io-21.1 {Chan CloseChannelsOnExit} emptyTest {
 } {}
 
-# Test management of attributes associated with a channel, such as
-# its default translation, its name and type, etc. The functions
-# tested in this group are Tcl_GetChannelName,
-# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
-# not tested because files do not use the instance data.
+# Test management of attributes associated with a channel, such as its default
+# translation, its name and type, etc. The functions tested in this group are
+# Tcl_GetChannelName, Tcl_GetChannelType and Tcl_GetChannelFile.
+# Tcl_GetChannelInstanceData not tested because files do not use the instance
+# data.
 
 test chan-io-22.1 {Tcl_GetChannelMode} emptyTest {
     # Not used anywhere in Tcl.
@@ -2722,7 +2691,7 @@ test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} \
 	set result ok
     }
 } ok
-test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
+test chan-io-29.33 {Tcl_Flush, implicit flush on exit} -setup {
     set f [open $path(script) w]
     chan puts $f "set f \[[list open $path(test1) w]]"
     chan puts $f {chan configure $f -translation lf
@@ -2731,13 +2700,14 @@ test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
 	chan puts $f strange
     }
     chan close $f
+} -constraints exec -body {
     exec [interpreter] $path(script)
     set f [open $path(test1) r]
-    set r [chan read $f]
+    chan read $f
+} -cleanup {
     chan close $f
-    set r
-} "hello\nbye\nstrange\n"
-test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {socket tempNotMac fileevent knownMsvcBug} {
+} -result "hello\nbye\nstrange\n"
+test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -setup {
     variable c 0
     variable x running
     set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
@@ -2746,6 +2716,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s
 	    chan puts $s $l
 	}
     }
+} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
     proc accept {s a p} {
 	variable x
 	chan event $s readable [namespace code [list readit $s]]
@@ -2772,7 +2743,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s
     chan close $ss
     vwait [namespace which -variable x]
     set c
-} 2000
+} -result 2000
 test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} {socket tempNotMac fileevent} {
     # On Mac, this test screws up sockets such that subsequent tests using port 2828
     # either cause errors or panic().
@@ -6890,10 +6861,11 @@ proc doFcopy {in out {bytes 0} {error {}}} {
 		-command [namespace code [list doFcopy $in $out]]]
     }
 }
-test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy} {
+test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
     variable fcopyTestDone
     file delete $path(pipe)
     catch {unset fcopyTestDone}
+} -constraints {stdio openpipe fcopy} -body {
     set fcopyTestCount 0
     set f1 [open $path(pipe) w]
     chan puts $f1 {
@@ -6912,18 +6884,19 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy
 	exit 0
     }
     chan close $f1
-    set in [open "|[list [interpreter] $path(pipe) &]" r+]
+    set in [openpipe r+ $path(pipe) &]
     set out [open $path(test1) w]
     doFcopy $in $out
     variable fcopyTestDone
-    if ![info exists fcopyTestDone] {
+    if {![info exists fcopyTestDone]} {
 	vwait [namespace which -variable fcopyTestDone]
     }
-    catch {chan close $in}
-    chan close $out
     # -1=error 0=script error N=number of bytes
     expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
-} {3450}
+} -cleanup {
+    catch {chan close $in}
+    chan close $out
+} -result {3450}
 test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
     # copy progress callback. errors out intentionally
     proc ::cmd args {
@@ -7081,7 +7054,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
 	    global l srv
 	    chan configure $sok -translation binary -buffering none
 	    lappend l $sok
-	    if {[llength $l]==2} {
+	    if {[llength $l] == 2} {
 		chan close $srv
 		foreach {a b} $l break
 		chan copy $a $b -command [list geof $a]
@@ -7133,7 +7106,6 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
 test chan-io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
     # event loops when there is buffered data on the channel.
-
     proc accept {s a p} {
 	variable as
 	chan configure $s -translation lf
@@ -7152,13 +7124,13 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} {
 	incr x
     }
     set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
-
-    # We need to delay on some systems until the creation of the
-    # server socket completes.
-
+    # We need to delay on some systems until the creation of the server socket
+    # completes.
     set done 0
     for {set i 0} {$i < 10} {incr i} {
-	if {![catch {set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]}]} {
+	if {![catch {
+	    set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]
+	}]} {
 	    set done 1
 	    break
 	}
@@ -7184,65 +7156,56 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} {
     chan close $cs
     list $result $x
 } {{{line 1} 1 2} 2}
-test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} {
+test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup {
     set accept {}
     set after {}
+    variable done 0
+} -constraints {socket fileevent} -body {
     variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     proc accept {s a p} {
-	variable counter
-	variable accept
-
-	set accept $s
-	set counter 0
+	variable counter 0
+	variable accept $s
 	chan configure $s -blocking off -buffering line -translation lf
 	chan event $s readable [namespace code "doit $s"]
     }
     proc doit {s} {
 	variable counter
 	variable after
-
 	incr counter
-	set l [chan gets $s]
-	if {"$l" == ""} {
+	if {[chan gets $s] eq ""} {
 	    chan event $s readable [namespace code "doit1 $s"]
-	    set after [after 1000 [namespace code newline]]
+	    set after [after 1000 [namespace code {
+		chan puts $writer hello
+		chan flush $writer
+		set done 1
+	    }]]
 	}
     }
     proc doit1 {s} {
 	variable counter
 	variable accept
-
 	incr counter
-	set l [chan gets $s]
+	chan gets $s
 	chan close $s
 	set accept {}
     }
     proc producer {} {
 	variable s
 	variable writer
-
 	set writer [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]]
 	chan configure $writer -buffering line
 	chan puts -nonewline $writer hello
 	chan flush $writer
     }
-    proc newline {} {
-	variable done
-	variable writer
-
-	chan puts $writer hello
-	chan flush $writer
-	set done 1
-    }
     producer
-    variable done
     vwait [namespace which -variable done]
     chan close $writer
     chan close $s
     after cancel $after
-    if {$accept != {}} {chan close $accept}
     set counter
-} 1
+} -cleanup {
+    if {$accept != {}} {chan close $accept}
+} -result 1
 
 set path(fooBar) [makeFile {} fooBar]
 
@@ -7292,14 +7255,15 @@ test chan-io-56.1 {ChannelTimerProc} {testchannelevent} {
     lappend result $y
 } {2 done}
 
-test chan-io-57.1 {buffered data and file events, gets} {fileevent} {
+test chan-io-57.1 {buffered data and file events, gets} -setup {
+    variable s2
+} -constraints {fileevent} -body {
     proc accept {sock args} {
 	variable s2
 	set s2 $sock
     }
     set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]]
-    variable s2
     vwait [namespace which -variable s2]
     update
     chan event $s2 readable [namespace code {lappend result readable}]
@@ -7310,19 +7274,21 @@ test chan-io-57.1 {buffered data and file events, gets} {fileevent} {
     vwait [namespace which -variable result]
     lappend result [chan gets $s2]
     vwait [namespace which -variable result]
+    set result
+} -cleanup {
     chan close $s
     chan close $s2
     chan close $server
-    set result
-} {12 readable 34567890 timer}
-test chan-io-57.2 {buffered data and file events, read} {fileevent} {
+} -result {12 readable 34567890 timer}
+test chan-io-57.2 {buffered data and file events, read} -setup {
+    variable s2
+} -constraints {fileevent} -body {
     proc accept {sock args} {
 	variable s2
 	set s2 $sock
     }
     set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]]
-    variable s2
     vwait [namespace which -variable s2]
     update
     chan event $s2 readable [namespace code {lappend result readable}]
@@ -7333,11 +7299,12 @@ test chan-io-57.2 {buffered data and file events, read} {fileevent} {
     vwait [namespace which -variable result]
     lappend result [chan read $s2 9]
     vwait [namespace which -variable result]
+    set result
+} -cleanup {
     chan close $s
     chan close $s2
     chan close $server
-    set result
-} {1 readable 234567890 timer}
+} -result {1 readable 234567890 timer}
 
 test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
     set out [open $path(script) w]
@@ -7358,7 +7325,7 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin op
 	}
     }
     chan close $out
-    set pipe [open "|[list [interpreter] $path(script)]" r]
+    set pipe [openpipe r $path(script)]
     chan event $pipe readable [namespace code [list readit $pipe]]
     variable x ""
     set result ""
@@ -7368,11 +7335,9 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin op
 
 test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
     # TIP #10
-    # More complicated tests (like that the reference changes as a
-    # channel is moved from thread to thread) can be done only in the
-    # extension which fully implements the moving of channels between
-    # threads, i.e. 'Threads'. Or we have to extend [testthread] as well.
-
+    # More complicated tests (like that the reference changes as a channel is
+    # moved from thread to thread) can be done only in the extension which
+    # fully implements the moving of channels between threads, i.e. 'Threads'.
     set f [open $path(longfile) r]
     set result [testchannel mthread $f]
     chan close $f
@@ -7381,7 +7346,6 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
 
 test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
     # This test will hang in older revisions of the core.
-
     set out [open $path(script) w]
     chan puts $out {
 	chan puts [encoding convertfrom identity \xe2]
@@ -7399,12 +7363,11 @@ test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
 	}
     }
     chan close $out
-    set pipe [open "|[list [interpreter] $path(script)]" r]
+    set pipe [openpipe r $path(script)]
     chan event $pipe readable [namespace code [list readit $pipe]]
     variable x ""
     set result ""
     vwait [namespace which -variable x]
-
     # cut of the remainder of the error stack, especially the filename
     set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
     list $x $result
@@ -7431,36 +7394,30 @@ test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
     #chan seek $f 0 start
     #chan seek $f 0 current
     #lappend res [chan read $f; chan tell $f]
-    chan close $f
-    set res
 } -cleanup {
+    chan close $f
     removeFile eofchar
 } -result {77 = 23431}
 
-
 # Test the cutting and splicing of channels, this is incidentially the
-# attach/detach facility of package Thread, but __without any
-# safeguards__. It can also be used to emulate transfer of channels
-# between threads, and is used for that here.
+# attach/detach facility of package Thread, but __without any safeguards__. It
+# can also be used to emulate transfer of channels between threads, and is
+# used for that here.
 
-test chan-io-70.0 {Cutting & Splicing channels} {testchannel} {
+test chan-io-70.0 {Cutting & Splicing channels} -setup {
     set f [makeFile {... dummy ...} cutsplice]
+    set res {}
+} -constraints {testchannel} -body {
     set c [open $f r]
-
-    set     res {}
     lappend res [catch {chan seek $c 0 start}]
     testchannel cut $c
-
     lappend res [catch {chan seek $c 0 start}]
     testchannel splice $c
-
     lappend res [catch {chan seek $c 0 start}]
+} -cleanup {
     chan close $c
-
     removeFile cutsplice
-
-    set res
-} {0 1 0}
+} -result {0 1 0}
 
 
 # Duplicate of code in "thread.test". Find a better way of doing this
@@ -7699,7 +7656,7 @@ test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
 } {1}
 
 # ### ### ### ######### ######### #########
-
+
 # cleanup
 foreach file [list fooBar longfile script output test1 pipe my_script \
 	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
-- 
cgit v0.12