summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--library/init.tcl4
-rw-r--r--tests/chanio.test399
-rw-r--r--tests/fCmd.test255
-rw-r--r--win/makefile.bc26
-rw-r--r--win/makefile.vc60
5 files changed, 361 insertions, 383 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/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] {
diff --git a/tests/fCmd.test b/tests/fCmd.test
index d79ac79..040882b 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -162,8 +162,8 @@ proc contents {file} {
set root [lindex [file split [pwd]] 0]
-# A really long file name
-# length of long is 1216 chars, which should be greater than any static buffer
+# A really long file name.
+# Length of long is 1216 chars, which should be greater than any static buffer
# or allowable filename.
set long "abcdefghihjllmnopqrstuvwxyz01234567890"
@@ -172,20 +172,22 @@ append long $long
append long $long
append long $long
append long $long
-
-test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
+
+test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup {
cleanup
+} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
+} -result {tf2}
-test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
+test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup {
cleanup
+} -body {
createfile tf1
file copy tf1 tf2
lsort [glob tf*]
-} {tf1 tf2}
+} -result {tf1 tf2}
test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
file rename -xyz
@@ -230,27 +232,31 @@ test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup {
} -constraints {notRoot} -returnCodes error -body {
file copy -force -- tf1 tf2 tf3
} -result {error copying: target "tf3" is not a directory}
-test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
+test fCmd-3.10 {FileCopyRename: just 2 arguments} -constraints notRoot -setup {
cleanup
+} -body {
createfile tf1 tf1
file rename tf1 tf2
contents tf2
-} {tf1}
-test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
+} -result {tf1}
+test fCmd-3.11 {FileCopyRename: just 2 arguments} -constraints notRoot -setup {
cleanup
+} -body {
createfile tf1 tf1
file rename -force -force -- tf1 tf2
contents tf2
-} {tf1}
-test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
+} -result {tf1}
+test fCmd-3.12 {FileCopyRename: move each source: 1 source} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1 tf1
file mkdir td1
file rename tf1 td1
contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
+} -result {tf1}
+test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1 tf1
createfile tf2 tf2
createfile tf3 tf3
@@ -259,7 +265,7 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
file rename tf1 tf2 tf3 tf4 td1
list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
[contents [file join td1 tf3]] [contents [file join td1 tf4]]
-} {tf1 tf2 tf3 tf4}
+} -result {tf1 tf2 tf3 tf4}
test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
@@ -284,22 +290,25 @@ test fCmd-3.16 {FileCopyRename: break on first error} -setup {
file rename tf1 tf2 tf3 tf4 td1
} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}]
-test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
+test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
glob td*
-} {td1}
-test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
+} -result {td1}
+test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1 td2 td3
lsort [glob td*]
-} {td1 td2 td3}
-test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
+} -result {td1 td2 td3}
+test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
catch {file mkdir td1 td2 tf1 td3 td4}
glob td1 td2 tf1 td3 td4
-} {td1 td2 tf1}
+} -result {td1 td2 tf1}
test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
@@ -310,36 +319,40 @@ test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setu
} -constraints {notRoot} -returnCodes error -body {
file mkdir ""
} -result {can't create directory "": no such file or directory}
-test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
+test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
glob td1
-} {td1}
-test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
+} -result {td1}
+test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir [file join td1 td2 td3 td4]
glob td1 [file join td1 td2]
-} "td1 [file join td1 td2]"
-test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
+} -result "td1 [file join td1 td2]"
+test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
set x [file exists td1]
file mkdir td1
list $x [file exists td1]
-} {1 1}
+} -result {1 1}
test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
createfile tf1
file mkdir tf1
} -result [subst {can't create directory "[file join tf1]": file already exists}]
-test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
+test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
set x [file exists td1]
file mkdir td1
list $x [file exists td1]
-} {1 1}
+} -result {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
cleanup
} -constraints {unix notRoot testchmod} -returnCodes error -body {
@@ -367,11 +380,12 @@ test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
} -returnCodes error -cleanup {
file delete -force foo
} -result {can't create directory "foo/tf1": permission denied}
-test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
+test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir tf1
file exists tf1
-} {1}
+} -result {1}
test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
file delete -xyz
@@ -379,51 +393,57 @@ test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -
test fCmd-5.2 {TclFileDeleteCmd: not enough args} -constraints {notRoot} -body {
file delete -force -force
} -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"}
-test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
+test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup {
cleanup
+} -body {
createfile tf1
createfile tf2
file mkdir td1
file delete tf2
glob tf* td*
-} {tf1 td1}
-test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
+} -result {tf1 td1}
+test fCmd-5.4 {TclFileDeleteCmd: multiple files} -constraints notRoot -setup {
cleanup
+} -body {
createfile tf1
createfile tf2
file mkdir td1
set x [list [file exists tf1] [file exists tf2] [file exists td1]]
file delete tf1 td1 tf2
lappend x [file exists tf1] [file exists tf2] [file exists tf3]
-} {1 1 1 0 0 0}
-test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrWin} {
+} -cleanup {cleanup} -result {1 1 1 0 0 0}
+test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
cleanup
+} -constraints {notRoot unixOrWin} -body {
createfile tf1
createfile tf2
file mkdir td1
catch {file delete tf1 td1 $root tf2}
list [file exists tf1] [file exists tf2] [file exists td1]
-} {0 1 0}
+} -cleanup {cleanup} -result {0 1 0}
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
file delete ~_totally_bogus_user
} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
-test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
+test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup {
catch {file delete ~/tf1}
+} -constraints {notRoot} -body {
createfile ~/tf1
file delete ~/tf1
-} {}
-test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
+} -result {}
+test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup {
cleanup
+} -constraints {notRoot} -body {
set x [file exists tf1]
file delete tf1
list $x [file exists tf1]
-} {0 0}
-test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
+} -result {0 0}
+test fCmd-5.9 {TclFileDeleteCmd: is directory} -constraints {notRoot} -setup {
cleanup
+} -body {
file mkdir td1
file delete td1
file exists td1
-} {0}
+} -result {0}
test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
@@ -442,14 +462,14 @@ test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup {
} -cleanup {
cd $dir
} -result {0 0 {}}
-test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} {
+test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} -setup {
cleanup
+} -constraints {unix} -body {
file mkdir [file join td1 td2]
- #exec chmod u-rwx [file join td1 td2]
file attributes [file join td1 td2] -permissions u+rwx
set res [list [catch {file delete -force td1} msg]]
lappend res [file exists td1] $msg
-} {0 0 {}}
+} -result {0 0 {}}
test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} {
# can't test this, because it's caught by FileCopyRename
@@ -462,18 +482,20 @@ test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup {
} -constraints {notRoot} -returnCodes error -body {
file rename tf1 tf2
} -result {error renaming "tf1": no such file or directory}
-test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
+test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
-test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
+} -result {tf2}
+test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
+} -result {tf2}
test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
cleanup
} -constraints {unix notRoot testchmod} -body {
@@ -490,12 +512,13 @@ test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
createfile tf1
file rename tf1 $long
} -result [subst {error renaming "tf1" to "$long": file name too long}]
-test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} {
+test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
cleanup
+} -constraints {unix notRoot} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
+} -result {tf2}
test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
@@ -510,13 +533,14 @@ test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
createfile tf2
file rename tf1 tf2
} -result {error renaming "tf1" to "tf2": file already exists}
-test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
+test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
createfile tf2
file rename -force tf1 tf2
glob tf*
-} {tf2}
+} -result {tf2}
test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
@@ -564,12 +588,13 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
file rename -force td2 td1
} -returnCodes error -match glob -result \
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
-test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {xdev notRoot} {
+test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
createfile tf1
file rename tf1 $tmpspace
glob -nocomplain tf* [file join $tmpspace tf1]
-} [file join $tmpspace tf1]
+} -result [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
@@ -582,23 +607,23 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
file delete -force c:/tcl8975@
catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
-test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
- {xdev notRoot} {
+test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir td1
file rename td1 $tmpspace
glob -nocomplain td* [file join $tmpspace td*]
-} [file join $tmpspace td1]
-test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
- {xdev notRoot} {
+} -result [file join $tmpspace td1]
+test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
createfile tf1
file rename tf1 $tmpspace
glob -nocomplain tf* [file join $tmpspace tf*]
-} [file join $tmpspace tf1]
+} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {notRoot xdev} -body {
+} -constraints {xdev notRoot} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
file rename td1 $tmpspace
@@ -696,15 +721,16 @@ test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
file mkdir [file join tf1 tf2]
file delete tf1
} -result {error deleting "tf1": directory not empty}
-test fCmd-7.2 {FileForceOption: -force} {notRoot} {
+test fCmd-7.2 {FileForceOption: -force} -constraints {notRoot} -setup {
cleanup
+} -body {
file mkdir [file join tf1 tf2]
file delete -force tf1
-} {}
-test fCmd-7.3 {FileForceOption: --} {notRoot} {
+} -result {}
+test fCmd-7.3 {FileForceOption: --} -constraints {notRoot} -body {
createfile -tf1
file delete -- -tf1
-} {}
+} -result {}
test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
createfile -tf1
} -body {
@@ -731,9 +757,9 @@ test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
file delete -force td1
} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
- {unix notRoot} {
+ -constraints {unix notRoot} -body {
string equal [file tail ~$user] ~$user
-} 0
+} -result 0
test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
file copy ~ [file join this file doesnt exist]
} -returnCodes error -result [subst \
@@ -767,7 +793,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
} -result {{tf3 tf4} 1 0}
test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {testchmod win2000orXP} -body {
+} -constraints {win2000orXP testchmod} -body {
file mkdir td1 td2
testchmod 555 td2
file rename td1 td3
@@ -787,15 +813,16 @@ test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup {
} -cleanup {
cleanup
} -result {{td3 td4} 1 0}
-test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
+test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1 tf1
createfile tf2 tf2
testchmod 444 tf2
file rename -force tf1 tf1
file rename -force tf2 tf2
list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
-} {tf1 tf2 1 0}
+} -result {tf1 tf2 1 0}
test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
cleanup
} -constraints {testchmod win2000orXP} -body {
@@ -808,7 +835,7 @@ test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
} -result {{td1 td2} 1 0}
test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup {
cleanup
-} -constraints {notRoot unix testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
file mkdir td1
file mkdir td2
testchmod 555 td2
@@ -843,9 +870,8 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup {
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
- # Under unix, you can rename a read-only directory, but you can't
- # move it into another directory.
-
+ # Under unix, you can rename a read-only directory, but you can't move it
+ # into another directory.
file mkdir td1
file mkdir [file join td2 td1]
file mkdir tds1
@@ -898,8 +924,9 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} -match glob -result \
[subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}]
-test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
+test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
file mkdir td1
@@ -908,9 +935,10 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot t
file rename tf2 [file join td1 tf4]
list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
+} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
file mkdir td1
file mkdir td2
file mkdir td3
@@ -926,7 +954,7 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot te
}
list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
[file writable [file join td3 td3]] $w4
-} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
+} -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-9.12 {file rename: comprehensive: target exists} -setup {
cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
@@ -947,18 +975,20 @@ test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
file rename -force td1 td2
} -returnCodes error -match glob -result \
[subst {error renaming "td1" to "[file join td2 td1]": file *}]
-test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
+test fCmd-9.14 {file rename: comprehensive: dir into self} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
-} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
-test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} {
+} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
+test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
file rename td1 td1x
file rename td1x td1
set msg "ok"
-} {ok}
+} -result {ok}
test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup {
cleanup
set dir [pwd]
@@ -1001,18 +1031,19 @@ test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup {
} -constraints {notRoot} -returnCodes error -body {
file copy tf1 tf2
} -result {error copying "tf1": no such file or directory}
-test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
+test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1 tf1
createfile tf2 tf2
testchmod 444 tf2
file copy tf1 tf3
file copy tf2 tf4
list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
-} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
+} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {notRoot unix testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
file mkdir [file join td1 tdx]
file mkdir [file join td2 tdy]
testchmod 555 td2
@@ -1026,7 +1057,7 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {notRoot win 2000orNewer testchmod} -body {
+} -constraints {win notRoot 2000orNewer testchmod} -body {
# On Windows with ACLs, copying a directory is defined like this
file mkdir [file join td1 tdx]
file mkdir [file join td2 tdy]
@@ -1113,7 +1144,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
-} -constraints {notRoot unix testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
file mkdir td1
file mkdir td2
file mkdir td3
@@ -1125,7 +1156,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
-} -constraints {notRoot win 2000orNewer testchmod} -body {
+} -constraints {win notRoot 2000orNewer testchmod} -body {
# On Windows with ACLs, copying a directory is defined like this
file mkdir td1
file mkdir td2
@@ -1166,7 +1197,7 @@ cleanup
# old tests
-test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup {
+test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup {
catch {file delete -force -- -tfa1}
} -body {
set s [createfile -tfa1]
@@ -1175,7 +1206,7 @@ test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup {
} -cleanup {
file delete tfa2
} -result {1 0}
-test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup {
+test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup {
catch {file delete -force -- tfa1}
} -body {
set s [createfile tfa1]
@@ -1184,9 +1215,9 @@ test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup {
} -cleanup {
file delete tfa1
} -result {1 1 0}
-test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
- catch {file rename -- }
-} {1}
+test fCmd-11.3 {TclFileRenameCmd: bad \# args} -returnCodes error -body {
+ file rename --
+} -match glob -result *
test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup {
set temp $::env(HOME)
} -constraints notRoot -body {
@@ -1369,9 +1400,9 @@ test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup {
} -cleanup {
file delete tfa1
} -result {1 1 0}
-test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
- catch {file copy -- }
-} {1}
+test fCmd-13.4 {TclCopyFilesCmd: bad \# args} -constraints {notRoot} -body {
+ file copy --
+} -returnCodes error -match glob -result *
test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
set temp $::env(HOME)
} -body {
@@ -1404,8 +1435,8 @@ test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup {
catch {file delete -force -- tfa1 tfa2 tfad}
} -constraints {notRoot} -body {
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
+ set s1 [createfile tfa1]
+ set s2 [createfile tfa2]
file mkdir tfad
file copy tfa1 tfa2 tfad
list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
@@ -1457,7 +1488,7 @@ test fCmd-14.3 {copyfile: stat failing on source} -setup {
test fCmd-14.4 {copyfile: error copying file to directory} -setup {
catch {file delete -force -- tfa tfad}
} -constraints {notRoot} -body {
- set s1 [createfile tfa ]
+ set s1 [createfile tfa]
file mkdir tfad
file mkdir tfad/tfa
list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \
@@ -1519,10 +1550,9 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
set ::env(HOME) $temp
} -result {1}
#
-# Can Tcl_SplitPath return argc == 0? If so them we need a
-# test for that code.
+# Can Tcl_SplitPath return argc == 0? If so them we need a test for that code.
#
-test fCmd-15.2 {TclMakeDirsCmd - one directory } -setup {
+test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
file mkdir tfa
@@ -1700,7 +1730,6 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
#
# Functionality tests for TclFileRenameCmd()
#
-
test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
-setup {
catch {file delete -force -- tfad}
@@ -1708,7 +1737,7 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
} -constraints {notRoot} -body {
file mkdir tfad/dir
cd tfad/dir
- set s [createfile foo ]
+ set s [createfile foo]
file rename foo bar
file rename bar ./foo
file rename ./foo bar
@@ -1853,7 +1882,6 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup {
file mkdir tfa1
set s [createfile tfa2]
file link -symbolic tfalink tfa1
-
file rename tfa2 tfalink
checkcontent tfa1/tfa2 $s
} -cleanup {
@@ -1905,12 +1933,10 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
# TclUnixDeleteFile and TraversalDelete are covered by tests from the
# TclDeleteFilesCmd suite
#
-#
#
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
-
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } -setup {
catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
@@ -2085,7 +2111,6 @@ test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup {
} -constraints {notRoot} -body {
set s [createfile tfa1]
set s2 [createfile tfa2 q]
-
set result [catch {file rename tfa1 tfa2}]
file rename -force tfa1 tfa2
lappend result [checkcontent tfa2 $s]
@@ -2127,7 +2152,6 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
} -constraints {notRoot} -body {
set s [createfile tfa1]
set s2 [createfile tfa2 q]
-
set result [catch {file copy tfa1 tfa2}]
file copy -force tfa1 tfa2
lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s]
@@ -2144,12 +2168,10 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
# TclMacRmdir
# Error cases are not covered.
#
-
test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup {
catch {file delete -force -- tfad}
} -constraints {notRoot} -body {
file mkdir [file join tfad dir]
-
list [catch {file delete tfad}] [file delete -force tfad]
} -cleanup {
catch {file delete -force tfad}
@@ -2207,14 +2229,12 @@ test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup
#
# Functionality tests for TclDeleteFilesCmd
#
-
test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup {
catch {file delete -force -- tfad1 tfad2}
} -constraints {unix notRoot} -body {
file mkdir tfad1
file link -symbolic tfalink tfad1
file delete tfalink
-
list [file isdir tfad1] [file exists tfalink]
} -cleanup {
file delete tfad1
@@ -2227,7 +2247,6 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup {
file mkdir tfad2
file link -symbolic [file join tfad2 link] [file join .. tfad1]
file delete -force tfad2
-
list [file isdir tfad1] [file exists tfad2]
} -cleanup {
file delete tfad1
@@ -2239,10 +2258,10 @@ test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup {
file link -symbolic tfad2 tfad1
file delete tfad1
file delete tfad2
-
list [file exists tfad1] [file exists tfad2]
} -result {0 0}
+# There is no fCmd-27.1
test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup {
set platform [testgetplatform]
} -constraints {testsetplatform} -body {
@@ -2402,7 +2421,7 @@ test fCmd-28.12 {file link: cd into a link} -setup {
cd ..
set up [pwd]
cd $orig
- # now '$up' should be either $orig or [file dirname abc.dir], depending on
+ # Now '$up' should be either $orig or [file dirname abc.dir], depending on
# whether 'cd' actually moves to the destination of a link, or simply
# treats the link as a directory. (On windows the former, on unix the
# latter, I believe)
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
generated by cgit v0.12 at 2024-11-16 15:13:37 (GMT)