From f976a32c62ccbb7a5740756f8641f1f73357e57e Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 4 May 2023 18:21:01 +0000 Subject: Remove mention of Tcl_GlobalEval() from comment. --- generic/tclHistory.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 24f6d65..0782629 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -58,8 +58,9 @@ Tcl_RecordAndEval( const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. - * TCL_EVAL_GLOBAL means use Tcl_GlobalEval - * instead of Tcl_Eval. */ + * TCL_EVAL_GLOBAL means evaluate the script + * in global variable context instead of the + * current procedure. */ { Tcl_Obj *cmdPtr; int length = strlen(cmd); -- cgit v0.12 From cc71607cb85a8d6266a40aad0c4b9bbe772efb35 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Thu, 4 May 2023 20:26:19 +0000 Subject: Make some tests select an encoding profile instead of relying on the default. --- generic/tclEncoding.c | 10 +- generic/tclHistory.c | 5 +- generic/tclIO.c | 8 +- tests/chanio.test | 2 +- tests/encoding.test | 43 +++-- tests/io.test | 514 ++++++++++++++++++++++++++------------------------ tests/ioCmd.test | 8 +- 7 files changed, 311 insertions(+), 279 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index b794eb2..3ab3de9 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1165,7 +1165,7 @@ Tcl_ExternalToUtfDString( * Tcl_ExternalToUtfDStringEx -- * * Convert a source buffer from the specified encoding into UTF-8. - * The parameter flags controls the behavior, if any of the bytes in + * "flags" controls the behavior if any of the bytes in * the source buffer are invalid or cannot be represented in utf-8. * Possible flags values: * target encoding. It should be composed by OR-ing the following: @@ -2588,10 +2588,10 @@ UtfToUtfProc( } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) { /* * Incomplete byte sequence. - * Always check before using TclUtfToUCS4. Not doing can so - * cause it run beyond the end of the buffer! If we happen such an - * incomplete char its bytes are made to represent themselves - * unless the user has explicitly asked to be told. + * Always check before using TclUtfToUCS4. Not doing so can cause it + * run beyond the end of the buffer! If we happen on such an incomplete + * char its bytes are made to represent themselves unless the user has + * explicitly asked to be told. */ if (flags & ENCODING_INPUT) { diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 9b950fa..dc5a67d 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -58,9 +58,8 @@ Tcl_RecordAndEval( const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. - * TCL_EVAL_GLOBAL means evaluate the script - * in global variable context instead of the - * current procedure. */ + * TCL_EVAL_GLOBAL means use Tcl_GlobalEval + * instead of Tcl_Eval. */ { Tcl_Obj *cmdPtr; int result; diff --git a/generic/tclIO.c b/generic/tclIO.c index 21aef59..987f6b9 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5931,7 +5931,7 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); - /* TODO: We don't need this call? */ + /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); Tcl_SetErrno(EILSEQ); return -1; @@ -5948,7 +5948,7 @@ DoReadChars( assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); - /* TODO: We don't need this call? */ + /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); return 0; } @@ -5962,7 +5962,7 @@ DoReadChars( } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - /* TODO: We don't need this call? */ + /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); return 0; } @@ -6009,7 +6009,7 @@ DoReadChars( } /* - * If the current buffer is empty recycle it. + * Recycle current buffer if empty. */ bufPtr = statePtr->inQueueHead; diff --git a/tests/chanio.test b/tests/chanio.test index 29ef1e7..e5e74cb 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -1098,7 +1098,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" chan close $f set f [open $path(test1)] - chan configure $f -encoding shiftjis + chan configure $f -encoding shiftjis -profile tcl8 lappend x [chan gets $f line] $line lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f] lappend x [chan gets $f line] $line diff --git a/tests/encoding.test b/tests/encoding.test index 09f3e42..26ddb69 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -464,7 +464,10 @@ test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} { test encoding-15.25 {UtfToUtfProc CESU-8} { encoding convertfrom cesu-8 \x00 } \x00 -test encoding-15.26 {UtfToUtfProc CESU-8} { +test {encoding-15.26 cesu-8 tclnull strict} {UtfToUtfProc CESU-8} { + encoding convertfrom -profile tcl8 cesu-8 \xC0\x80 +} \x00 +test {encoding-15.26 cesu-8 tclnull tcl8} {UtfToUtfProc CESU-8} { encoding convertfrom -profile tcl8 cesu-8 \xC0\x80 } \x00 test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} { @@ -562,24 +565,35 @@ test encoding-16.18 { return done } [namespace current]] } -result done -test encoding-16.19 {Utf16ToUtfProc, bug [d19fe0a5b]} -body { +test {encoding-16.19 strict} {Utf16ToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom -profile strict utf-16 "\x41\x41\x41" +} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'} +test {encoding-16.19 tcl8} {Utf16ToUtfProc, bug [d19fe0a5b]} -body { encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41" } -result \u4141\uFFFD -test encoding-16.20 {Utf16ToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body { +test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} \ + -constraints deprecated -body { encoding convertfrom utf-16 "\xD8\xD8" } -result \uD8D8 -test encoding-16.21 {Utf32ToUtfProc, bug [d19fe0a5b]} -body { +test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body { encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41" } -result \x00\uFFFD +test encoding-16.21.strict {Utf32ToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom -profile strict utf-32 "\x00\x00\x00\x00\x41\x41" +} -returnCodes 1 -result {unexpected byte sequence starting at index 4: '\x41'} + test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { encoding convertfrom -profile strict utf-16le \x00\xD8 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { encoding convertfrom -profile strict utf-16le \x00\xDC } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} -test encoding-16.24 {Utf32ToUtfProc} -body { - encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF" -} -result \uFFFD +test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body { + string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"] +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} +test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} { + encoding convertfrom -profile tcl8 utf-8 \xC0\x80 +} \x00 test encoding-16.25 {Utf32ToUtfProc} -body { encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01" } -result \uFFFD @@ -789,16 +803,19 @@ test encoding-24.10 {Parse valid or invalid utf-8} { test encoding-24.11 {Parse valid or invalid utf-8} { string length [encoding convertfrom -profile tcl8 utf-8 "\xEF\xBF\xBF"] } 1 -test encoding-24.12 {Parse valid or invalid utf-8} -body { +test encoding-24.12 {Parse invalid utf-8} -body { encoding convertfrom -profile strict utf-8 "\xC0\x81" } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} -test encoding-24.13 {Parse valid or invalid utf-8} -body { +test encoding-24.13 {Parse invalid utf-8} -body { encoding convertfrom -profile strict utf-8 "\xC1\xBF" } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'} -test encoding-24.14 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xC2\x80"] +test encoding-24.14 {Parse valid utf-8} { + expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"} } 1 -test encoding-24.15 {Parse valid or invalid utf-8} -body { +test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body { + encoding convertfrom -profile strict utf-8 "Z\xE0\x80" +} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'" +test encoding-24.15.tcl8 {Parse invalid utf-8, -profile tcl8} -body { encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80" } -result Z\xE0\u20AC test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body { @@ -855,7 +872,7 @@ test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body { test encoding-24.32 {Try to generate invalid utf-8} -body { encoding convertto utf-8 \uFFFF } -result \xEF\xBF\xBF -test encoding-24.33 {Try to generate noncharacter with -profile strict} -body { +test encoding-24.33 {Try to generate invalid utf-8} -body { encoding convertto -profile strict utf-8 \uFFFF } -result \xEF\xBF\xBF test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body { diff --git a/tests/io.test b/tests/io.test index fb21535..e380146 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1184,7 +1184,7 @@ test io-7.2 {FilterInputBytes: split up character in middle of buffer} { puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82" close $f set f [open $path(test1)] - fconfigure $f -encoding shiftjis + fconfigure $f -encoding shiftjis -profile tcl8 set x [list [gets $f line] $line [eof $f]] close $f set x @@ -1539,67 +1539,67 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { } "{} timeout {} timeout 牦 {} eof 0 {}" test io-12.6 {ReadChars: too many chars read} { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat 뻯 20][string repeat . 20]] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat 뻯 20][string repeat . 20]] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { - read $c 15 + read $c 15 } close $c } {} test io-12.7 {ReadChars: too many chars read [bc5b790099]} { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat 뻯 10]....뻯] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat 뻯 10]....뻯] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { - read $c 7 + read $c 7 } close $c } {} @@ -1614,7 +1614,7 @@ test io-12.8 {ReadChars: multibyte chars split} { close $f scan [string index $in end] %c } 160 -test io-12.9 {ReadChars: multibyte chars split} -body { +test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body { set f [open $path(test1) w] fconfigure $f -translation binary puts -nonewline $f [string repeat a 9]\xC2 @@ -1622,18 +1622,34 @@ test io-12.9 {ReadChars: multibyte chars split} -body { set f [open $path(test1)] fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10 set in [read $f] - close $f + read $f scan [string index $in end] %c } -cleanup { catch {close $f} } -result 194 -test io-12.10 {ReadChars: multibyte chars split} -body { +test {io-12.10 strict} {ReadChars: multibyte chars split} -body { set f [open $path(test1) w] fconfigure $f -translation binary puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] - fconfigure $f -encoding utf-8 -buffersize 11 + fconfigure $f -encoding utf-8 -profile strict -buffersize 10 + set in [read $f] + close $f + scan [string index $in end] %c +} -cleanup { + catch {close $f} +} -returnCodes 1 -match glob -result {error reading "file*":\ + invalid or incomplete multibyte or wide character} + + +test {io-12.10 tcl8} {ReadChars: multibyte chars split} -body { + set f [open $path(test1) w] + fconfigure $f -translation binary + puts -nonewline $f [string repeat a 9]\xC2 + close $f + set f [open $path(test1)] + fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10 set in [read $f] close $f scan [string index $in end] %c @@ -1990,7 +2006,7 @@ test io-14.9 {reuse of stdio special channels} {stdio fileevent} { file delete $path(test1) set f [open $path(script) w] puts $f { - array set path [lindex $argv 0] + array set path [lindex $argv 0] set f [open $path(test1) w] puts $f hello close $f @@ -2337,7 +2353,7 @@ test io-27.6 {FlushChannel, async flushing, async close} \ close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { - set x "$x$x" + set x "$x$x" } set f [open $path(output) w] close $f @@ -2351,9 +2367,9 @@ test io-27.6 {FlushChannel, async flushing, async close} \ vwait [namespace which -variable counter] } if {$counter == 1000} { - set result "file size only [file size $path(output)]" + set result "file size only [file size $path(output)]" } else { - set result ok + set result ok } } ok @@ -2427,9 +2443,9 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ vwait [namespace which -variable counter] } if {$counter == 1000} { - set result probably_broken + set result probably_broken } else { - set result ok + set result ok } } ok test io-28.4 Tcl_Close testchannel { @@ -4651,29 +4667,29 @@ test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { } -result {{} {} {} .......} test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) ....... - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ....... + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] if {$n > 3} {set n 3} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -4685,30 +4701,30 @@ test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { } -result {{} {} {} .......} test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [string repeat \ - [string repeat . 64]\n[string repeat . 25] 2] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - if {$n > 65} {set n 65} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [string repeat \ + [string repeat . 64]\n[string repeat . 25] 2] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 65} {set n 65} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -5429,8 +5445,8 @@ test io-36.3 {Tcl_InputBlocked vs files, short read} { } {0 abc 0 defghijklmnop 0 1} test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} { proc in {f} { - variable l - variable x + variable l + variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } @@ -5465,8 +5481,8 @@ test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles } {0 abc 0 defghijklmnop 0 1} test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} { proc in {f} { - variable l - variable x + variable l + variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } @@ -5863,7 +5879,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or set l } {{} auto} test io-39.24 {Tcl_SetChannelOption, server socket is not readable or - writable so we can't change -eofchar or -translation } { + writable so we can't change -eofchar or -translation } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] fconfigure $sock -eofchar D -translation lf @@ -6361,23 +6377,23 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent not test io-46.2 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { - variable x 0 - after 100 {set x triggered} - vwait [namespace which -variable x] - set x + variable x 0 + after 100 {set x triggered} + vwait [namespace which -variable x] + set x } } {triggered} test io-46.3 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { - set x 0 - after 10 {lappend x timer} - after 30 - set result $x - update idletasks - lappend result $x - update - lappend result $x + set x 0 + after 10 {lappend x timer} + after 30 + set result $x + update idletasks + lappend result $x + update + lappend result $x } } {0 0 {0 timer}} @@ -6394,7 +6410,7 @@ test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} { lappend x [fileevent $f2 readable] testfevent delete lappend x [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] + [fileevent $f3 readable] close $f close $f2 close $f3 @@ -6410,11 +6426,11 @@ test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} { testfevent share $f2 testfevent share $f3 testfevent cmd "fileevent $f2 readable {script 2} - fileevent $f3 readable {script 3}" + fileevent $f3 readable {script 3}" fileevent $f4 readable {script 4} testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] [fileevent $f4 readable]] + [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 @@ -6432,7 +6448,7 @@ test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} { fileevent $f readable {script 1} fileevent $f2 readable {script 2} testfevent cmd "fileevent $f3 readable {script 3} - fileevent $f4 readable {script 4}" + fileevent $f4 readable {script 4}" testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] [fileevent $f4 readable]] @@ -6451,8 +6467,8 @@ test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent $f readable {script 2} fileevent $f2 readable {script 3} set x [list [fileevent $f2 readable] \ - [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [testfevent cmd "fileevent $f readable"] \ + [fileevent $f readable]] testfevent delete close $f close $f2 @@ -6466,7 +6482,7 @@ test io-47.5 {file events on shared files, deleting file events} {testfevent fil fileevent $f readable {script 2} testfevent cmd "fileevent $f readable {}" set x [list [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [fileevent $f readable]] testfevent delete close $f set x @@ -7322,7 +7338,7 @@ test io-52.3 {TclCopyChannel} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7363,7 +7379,7 @@ test io-52.5 {TclCopyChannel, all} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7380,7 +7396,7 @@ test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7397,7 +7413,7 @@ test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7414,7 +7430,7 @@ test io-52.6 {TclCopyChannel} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7431,7 +7447,7 @@ test io-52.7 {TclCopyChannel} {fcopy} { close $f1 close $f2 if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7985,8 +8001,8 @@ proc doFcopy {in out {bytes 0} {error {}}} { } elseif {[eof $in]} { set fcopyTestDone 0 } else { - # Delay next fcopy to wait for size>0 input bytes - after 100 [list fcopy $in $out -size 1000 \ + # Delay next fcopy to wait for size>0 input bytes + after 100 [list fcopy $in $out -size 1000 \ -command [namespace code [list doFcopy $in $out]]] } } @@ -8001,9 +8017,9 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} { proc Write {count} { puts -nonewline "1234567890" if {[incr count -1]} { - after 10 [list Write $count] + after 10 [list Write $count] } else { - set ::ready 1 + set ::ready 1 } } fconfigure stdout -buffering none @@ -8345,21 +8361,21 @@ test io-53.12.1 { } A test io-53.13 {TclCopyChannel: read error reporting} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - return {initialize finalize watch read} - } - finalize { - return - } - watch {} - read { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch read} + } + finalize { + return + } + watch {} + read { error FAIL - } - } + } + } } set outFile [makeFile {} out] } -body { @@ -8375,21 +8391,21 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup { } -result {error reading "rc*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - return {initialize finalize watch write} - } - finalize { - return - } - watch {} - write { - error FAIL - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch write} + } + finalize { + return + } + watch {} + write { + error FAIL + } + } } set inFile [makeFile {aaa} in] } -body { @@ -8405,35 +8421,35 @@ test io-53.14 {TclCopyChannel: write error reporting} -setup { } -result {error writing "*": *} -returnCodes error -match glob test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { proc driver {cmd args} { - variable buffer - variable index - variable blocked - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat a 100]] - set blocked($chan) 1 - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) blocked($chan) - return - } - watch {} - read { - if {$blocked($chan)} { - set blocked($chan) [expr {!$blocked($chan)}] - return -code error EAGAIN - } - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + variable blocked + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat a 100]] + set blocked($chan) 1 + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) blocked($chan) + return + } + watch {} + read { + if {$blocked($chan)} { + set blocked($chan) [expr {!$blocked($chan)}] + return -code error EAGAIN + } + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 @@ -8449,35 +8465,35 @@ test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { } -result 100 test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup { proc driver {cmd args} { - variable buffer - variable index - variable blocked - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat a 100]] - set blocked($chan) 1 - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) blocked($chan) - return - } - watch {} - read { - if {$blocked($chan)} { - set blocked($chan) [expr {!$blocked($chan)}] - return -code error EAGAIN - } - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + variable blocked + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat a 100]] + set blocked($chan) 1 + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) blocked($chan) + return + } + watch {} + read { + if {$blocked($chan)} { + set blocked($chan) [expr {!$blocked($chan)}] + return -code error EAGAIN + } + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 -translation lf @@ -8493,29 +8509,29 @@ test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup { } -result 100 test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - line\n[string repeat a 100]line\n] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + line\n[string repeat a 100]line\n] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 -translation lf -buffersize 107 diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 1c06ba3..471659a 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -1367,7 +1367,7 @@ test iocmd-24.15 {chan write, EAGAIN means that writing is not allowed at this t test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { set res {} - proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} + proc foo args {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c] close $c @@ -1376,7 +1376,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} - proc foo {args} {oninit cget cgetall; onfinal; track; return ""} + proc foo args {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] note [fconfigure $c] close $c @@ -1385,9 +1385,9 @@ test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} - proc foo {args} { + proc foo args { oninit cget cgetall; onfinal; track - return "-bar foo -snarf x" + return {-bar foo -snarf x} } set c [chan create {r w} foo] note [fconfigure $c] -- cgit v0.12 From 3e05a7babe9e956c84144a05bdf7a1acdd38611f Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 5 May 2023 09:40:38 +0000 Subject: Remove TclArithSeriesObjCopy() and use Tcl_DuplicateObj() instead. --- generic/tclArithSeries.c | 46 ---------------------------------------------- generic/tclArithSeries.h | 2 -- generic/tclCmdAH.c | 2 +- generic/tclListObj.c | 2 +- 4 files changed, 2 insertions(+), 50 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 4571b4a..1019677 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -760,52 +760,6 @@ SetArithSeriesFromAny( /* *---------------------------------------------------------------------- * - * TclArithSeriesObjCopy -- - * - * Makes a "pure arithSeries" copy of an ArithSeries value. This provides for the C - * level a counterpart of the [lrange $list 0 end] command, while using - * internals details to be as efficient as possible. - * - * Results: - * - * Normally returns a pointer to a new Tcl_Obj, that contains the same - * arithSeries value as *arithSeriesObj does. The returned Tcl_Obj has a - * refCount of zero. If *arithSeriesObj does not hold an arithSeries, - * NULL is returned, and if interp is non-NULL, an error message is - * recorded there. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclArithSeriesObjCopy( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *arithSeriesObj) /* List object for which an element array is - * to be returned. */ -{ - Tcl_Obj *copyPtr; - ArithSeries *arithSeriesRepPtr; - - arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); - if (NULL == arithSeriesRepPtr) { - if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) { - /* We know this is going to panic, but it's the message we want */ - return NULL; - } - } - - TclNewObj(copyPtr); - TclInvalidateStringRep(copyPtr); - DupArithSeriesInternalRep(arithSeriesObj, copyPtr); - return copyPtr; -} - -/* - *---------------------------------------------------------------------- - * * TclArithSeriesObjRange -- * * Makes a slice of an ArithSeries value. diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h index 61538c4..8002239 100644 --- a/generic/tclArithSeries.h +++ b/generic/tclArithSeries.h @@ -34,8 +34,6 @@ typedef struct { } ArithSeriesDbl; -MODULE_SCOPE Tcl_Obj * TclArithSeriesObjCopy(Tcl_Interp *interp, - Tcl_Obj *arithSeriesPtr); MODULE_SCOPE Tcl_Obj *TclArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *, Tcl_WideInt index); MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Interp *interp, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index e2186ed..4045e2f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2811,7 +2811,7 @@ EachloopCmd( /* Values */ if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType.objType)) { /* Special case for Arith Series */ - statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]); + statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]); if (statePtr->aCopyList[i] == NULL) { result = TCL_ERROR; goto done; diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 726b8dd..257925e 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1386,7 +1386,7 @@ TclListObjCopy( if (!TclHasInternalRep(listObj, &tclListType.objType)) { if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) { - return TclArithSeriesObjCopy(interp, listObj); + return Tcl_DuplicateObj(listObj); } if (SetListFromAny(interp, listObj) != TCL_OK) { return NULL; -- cgit v0.12 From 4e92d998ebfea666fec1ffcb3b5e44bf6d2d67fd Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 5 May 2023 12:34:18 +0000 Subject: Minor fixes for perf tests --- tests-perf/listPerf.tcl | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/tests-perf/listPerf.tcl b/tests-perf/listPerf.tcl index 17f22e9..575c78e 100644 --- a/tests-perf/listPerf.tcl +++ b/tests-perf/listPerf.tcl @@ -3,8 +3,9 @@ # # listPerf.tcl -- # -# This file provides performance tests for list operations. -# +# This file provides performance tests for list operations. Run +# tclsh listPerf.tcl help +# for options. # ------------------------------------------------------------------------ # # See the file "license.terms" for information on usage and redistribution @@ -77,7 +78,9 @@ namespace eval perf::list { break } --* { - error "Unknown option $arg" + puts stderr "Unknown option $arg" + print_usage + exit 1 } default { # Remaining will be passed back to the caller @@ -383,6 +386,8 @@ namespace eval perf::list { comment Create a list from two lists - real test of expansion speed perf measure [list_describe $len "from a {*}list {*}list"] {list {*}$L {*}$L} [list len [expr {$len/2}]] } + + perf destroy } proc lappend_describe {share_mode len num iters} { @@ -1217,7 +1222,7 @@ namespace eval perf::list { set commands [lmap sel $selections { if {$sel eq "help"} { print_usage - continue + exit 0 } set cmd ::perf::list::${sel}_perf if {$cmd ni [info commands ::perf::list::*_perf]} { -- cgit v0.12 From f4cd60dbb4c40a75914ae6823f7907870d6c97bb Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 5 May 2023 14:57:38 +0000 Subject: A few corrections in comments. --- generic/tclAssembly.c | 2 +- generic/tclCompile.c | 4 ++-- generic/tclExecute.c | 5 ++--- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 910532e..4aa241a 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -2247,7 +2247,7 @@ static int GetListIndexOperand( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr, /* Current token from the parser */ - int* result) /* OUTPUT: Integer extracted from the token */ + int* result) /* OUTPUT: encoded index derived from the token */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 926c492..b974c30 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -720,8 +720,8 @@ const Tcl_ObjType tclByteCodeType = { }; /* - * subtCodeType provides the standard type managemnt procedures for the - * substcode type, which represents substiution within a Tcl value. + * substCodeType provides the standard type management procedures for the + * substcode type, which represents substitution within a Tcl value. */ static const Tcl_ObjType substCodeType = { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 647e3db..9b733b3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -113,9 +113,8 @@ typedef struct { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ Tcl_Obj **catchTop; /* These fields are used on return TO this */ - Tcl_Obj *auxObjList; /* this level: they record the state when a */ - CmdFrame cmdFrame; /* new codePtr was received for NR */ - /* execution. */ + Tcl_Obj *auxObjList; /* level: they record the state when a new */ + CmdFrame cmdFrame; /* codePtr was received for NR execution. */ Tcl_Obj *stack[1]; /* Start of the actual combined catch and obj * stacks; the struct will be expanded as * necessary */ -- cgit v0.12 From 67b780c161dd0f32a2780ea1465999daba7f941e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 May 2023 20:55:31 +0000 Subject: Remove .github and .travis-related stuff: No need to build this branch any more --- .github/workflows/linux-build.yml | 51 ------ .github/workflows/mac-build.yml | 59 ------- .github/workflows/win-build.yml | 81 ---------- .travis.yml | 331 -------------------------------------- unix/Makefile.in | 3 - 5 files changed, 525 deletions(-) delete mode 100644 .github/workflows/linux-build.yml delete mode 100644 .github/workflows/mac-build.yml delete mode 100644 .github/workflows/win-build.yml delete mode 100644 .travis.yml diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml deleted file mode 100644 index d619507..0000000 --- a/.github/workflows/linux-build.yml +++ /dev/null @@ -1,51 +0,0 @@ -name: Linux -on: [push] -permissions: - contents: read -jobs: - gcc: - runs-on: ubuntu-20.04 - strategy: - matrix: - cfgopt: - - "" - - "--disable-shared" - - "--enable-symbols" - - "--enable-symbols=mem" - - "CFLAGS=-DTCL_UTF_MAX=4" - defaults: - run: - shell: bash - working-directory: unix - steps: - - name: Checkout - uses: actions/checkout@v3 - - name: Prepare - run: touch tclStubInit.c - working-directory: generic - - name: Configure ${{ matrix.cfgopt }} - run: | - mkdir "${HOME}/install" - ./configure ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1) - env: - CFGOPT: ${{ matrix.cfgopt }} - - name: Build - run: | - make all - - name: Build Test Harness - run: | - make tcltest - - name: Run Tests - run: | - make test - env: - ERROR_ON_FAILURES: 1 - - name: Test-Drive Installation - run: | - make install - - name: Create Distribution Package - run: | - make dist - - name: Convert Documentation to HTML - run: | - make html-tcl diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml deleted file mode 100644 index 5b0c657..0000000 --- a/.github/workflows/mac-build.yml +++ /dev/null @@ -1,59 +0,0 @@ -name: macOS -on: [push] -permissions: - contents: read -jobs: - xcode: - runs-on: macos-10.15 - defaults: - run: - shell: bash - working-directory: macosx - steps: - - name: Checkout - uses: actions/checkout@v3 - - name: Prepare - run: touch tclStubInit.c - working-directory: generic - - name: Build - run: make all - - name: Run Tests - run: make test styles=develop - env: - ERROR_ON_FAILURES: 1 - MAC_CI: 1 - clang: - runs-on: macos-10.15 - strategy: - matrix: - cfgopt: - - "" - - "--disable-shared" - - "--enable-symbols" - - "--enable-symbols=mem" - defaults: - run: - shell: bash - working-directory: unix - steps: - - name: Checkout - uses: actions/checkout@v3 - - name: Prepare - run: | - touch tclStubInit.c - mkdir "$HOME/install" - working-directory: generic - - name: Configure ${{ matrix.cfgopt }} - # Note that macOS is always a 64 bit platform - run: ./configure --enable-64bit --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1) - env: - CFGOPT: ${{ matrix.cfgopt }} - - name: Build - run: | - make all tcltest - - name: Run Tests - run: | - make test - env: - ERROR_ON_FAILURES: 1 - MAC_CI: 1 diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml deleted file mode 100644 index 9a0ac98..0000000 --- a/.github/workflows/win-build.yml +++ /dev/null @@ -1,81 +0,0 @@ -name: Windows -on: [push] -permissions: - contents: read -jobs: - msvc: - runs-on: windows-2019 - defaults: - run: - shell: powershell - working-directory: win - strategy: - matrix: - cfgopt: - - "OPTS=threads" - - "OPTS=static,msvcrt,threads" - - "OPTS=symbols,threads" - - "OPTS=memdbg,threads" - # Using powershell means we need to explicitly stop on failure - steps: - - name: Checkout - uses: actions/checkout@v3 - - name: Init MSVC - uses: ilammy/msvc-dev-cmd@v1 - - name: Build ${{ matrix.cfgopt }} - run: | - &nmake -f makefile.vc ${{ matrix.cfgopt }} all - if ($lastexitcode -ne 0) { - throw "nmake exit code: $lastexitcode" - } - - name: Build Test Harness ${{ matrix.cfgopt }} - run: | - &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest - if ($lastexitcode -ne 0) { - throw "nmake exit code: $lastexitcode" - } - - name: Run Tests ${{ matrix.cfgopt }} - run: | - &nmake -f makefile.vc ${{ matrix.cfgopt }} test - if ($lastexitcode -ne 0) { - throw "nmake exit code: $lastexitcode" - } - env: - ERROR_ON_FAILURES: 1 - gcc: - runs-on: windows-2019 - defaults: - run: - shell: bash - working-directory: win - strategy: - matrix: - cfgopt: - - "" - - "--disable-shared" - - "--enable-symbols" - - "--enable-symbols=mem" - # Using powershell means we need to explicitly stop on failure - steps: - - name: Checkout - uses: actions/checkout@v3 - - name: Install MSYS2 and Make - run: choco install msys2 make - - name: Prepare - run: | - touch tclStubInit.c - mkdir "${HOME}/install" - working-directory: generic - - name: Configure ${{ matrix.cfgopt }} - run: | - ./configure ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1) - env: - CFGOPT: --enable-64bit --enable-threads ${{ matrix.cfgopt }} - - name: Build - run: make all - - name: Build Test Harness - run: make tcltest - - name: Run Tests - run: make test - env: - ERROR_ON_FAILURES: 1 diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 6447b34..0000000 --- a/.travis.yml +++ /dev/null @@ -1,331 +0,0 @@ -language: c -addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - binutils-mingw-w64-i686 - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64 - - gcc-mingw-w64-base - - gcc-mingw-w64-i686 - - gcc-mingw-w64-x86-64 - - gcc-multilib -jobs: - include: -# Testing on Linux GCC - - name: "Linux/GCC/Shared" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - name: "Linux/GCC/Shared: UTF_MAX=4" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 - - name: "Linux/GCC/Shared: UTF_MAX=5" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=5 - - name: "Linux/GCC/Shared: UTF_MAX=6" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - - name: "Linux/GCC/Static" - os: linux - dist: focal - compiler: gcc - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - - name: "Linux/GCC/Debug" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols" - - name: "Linux/GCC/Mem-Debug" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols=mem" -# Newer/Older versions of GCC - - name: "Linux/GCC 10/Shared" - os: linux - dist: focal - compiler: gcc-10 - addons: - apt: - packages: - - g++-10 - env: - - BUILD_DIR=unix - - name: "Linux/GCC 5/Shared" - os: linux - dist: bionic - compiler: gcc-5 - addons: - apt: - packages: - - g++-5 - env: - - BUILD_DIR=unix -# Testing on Linux Clang - - name: "Linux/Clang/Shared" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - name: "Linux/Clang/Static" - os: linux - dist: focal - compiler: clang - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - - name: "Linux/Clang/Debug" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols" - - name: "Linux/Clang/Mem-Debug" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols=mem" -# Testing on Mac, various styles - - name: "macOS/Xcode 12/Shared" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=macosx - install: [] - script: &mactest - - make all - # The styles=develop avoids some weird problems on OSX - - make test styles=develop - - name: "macOS/Xcode 12/Shared/Unix-like" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=unix -# Newer MacOS versions - - name: "macOS/Xcode 12/Universal Apps/Shared" - os: osx - osx_image: xcode12u - env: - - BUILD_DIR=macosx - install: [] - script: *mactest -# Older MacOS versions - - name: "macOS/Xcode 11/Shared" - os: osx - osx_image: xcode11.7 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Xcode 10/Shared" - os: osx - osx_image: xcode10.3 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Xcode 9/Shared" - os: osx - osx_image: xcode9.4 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Xcode 8/Shared" - os: osx - osx_image: xcode8.3 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest -# Test with mingw-w64 cross-compile -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows/GCC/Shared/no test" - os: linux - dist: focal - compiler: x86_64-w64-mingw32-gcc - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads" - script: &crosstest - - make all tcltest - # Include a high visibility marker that tests are skipped outright - - > - echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" -# Test with mingw-w64 (32 bit) cross-compile -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows-32/GCC/Shared/no test" - os: linux - dist: focal - compiler: i686-w64-mingw32-gcc - env: - - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 --enable-threads" - script: *crosstest -# Test on Windows with MSVC native - - name: "Windows/MSVC/Shared" - os: windows - compiler: cl - env: &vcenv - - BUILD_DIR=win - - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" - before_install: &vcpreinst - - PATH="$PATH:$VCDIR" - - cd ${BUILD_DIR} - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=threads' '-f' makefile.vc test - - name: "Windows/MSVC/Static" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt,threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt,threads' '-f' makefile.vc test - - name: "Windows/MSVC/Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols,threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols,threads' '-f' makefile.vc test - - name: "Windows/MSVC/Mem-Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg OPTS=threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg OPTS=threads' '-f' makefile.vc test -# Test on Windows with MSVC native (32-bit) - - name: "Windows/MSVC-x86/Shared" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=threads' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Static" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt,threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt,threads' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols,threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols,threads' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Mem-Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg OPTS=threads' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg OPTS=threads' '-f' makefile.vc test -# Test on Windows with GCC native - - name: "Windows/GCC/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-threads" - before_install: &makepreinst - - choco install -y make - - cd ${BUILD_DIR} - - name: "Windows/GCC/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-threads --disable-shared" - before_install: *makepreinst - - name: "Windows/GCC/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-threads --enable-symbols" - before_install: *makepreinst -# Test on Windows with GCC native (32-bit) - - name: "Windows/GCC-x86/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-threads" - before_install: *makepreinst - - name: "Windows/GCC-x86/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-threads --disable-shared" - before_install: *makepreinst - - name: "Windows/GCC-x86/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-threads --enable-symbols" - before_install: *makepreinst - - name: "Windows/GCC-x86/Mem-Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-threads --enable-symbols=mem" - before_install: *makepreinst -before_install: - - touch generic/tclStubInit.c - - cd ${BUILD_DIR} -install: - - ./configure ${CFGOPT} --prefix=$HOME || (cat config.log && exit 1) -before_script: - - export ERROR_ON_FAILURES=1 -script: - - make all tcltest || echo "Something wrong, maybe a hickup, let's try again" - - make test diff --git a/unix/Makefile.in b/unix/Makefile.in index d25dfdd..bc3cdfe 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1747,9 +1747,6 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M @mkdir $(DISTDIR)/libtommath cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ $(DISTDIR)/libtommath - cp -p $(TOP_DIR)/.travis.yml $(DISTDIR) - mkdir -p $(DISTDIR)/.github/workflows - cp -p $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) -- cgit v0.12 From 73dbbaaa23c0ab5d0233211c9f2e34782991a87d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 7 May 2023 20:06:50 +0000 Subject: New testcase, contributed by @chrstphrchvz. Many thanks! See [3837178c25] --- tests/dstring.test | 18 ++++++++++++++++++ tests/tailcall.test | 2 +- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/tests/dstring.test b/tests/dstring.test index 6cf4bb8..59b3459 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -418,6 +418,24 @@ test dstring-4.2 {truncation} -constraints testdstring -setup { } -cleanup { testdstring free } -result {{} 0} +test dstring-4.3 {truncation} -constraints testdstring -setup { + testdstring free +} -body { + testdstring append "xwvut" -1 + # Pass a negative length to Tcl_DStringSetLength(); + # if not caught, causing '\0' to be written out-of-bounds, + # try corrupting dsPtr->length which begins + # 2*sizeof(Tcl_Size) bytes before dsPtr->staticSpace[], + # so that the result is -256 (on little endian systems) + # rather than e.g. -8 or -16. + # (sizeof(Tcl_Size) does not seem to be available via Tcl, + # so assume sizeof(Tcl_Size) == sizeof(void*) for Tcl 9.) + testdstring trunc [expr {-2*([package vsatisfies $tcl_version 9.0-] + ? $tcl_platform(pointerSize) : 4)}] + list [testdstring get] [testdstring length] +} -cleanup { + testdstring free +} -result {{} 0} test dstring-5.1 {copying to result} -constraints testdstring -setup { testdstring free diff --git a/tests/tailcall.test b/tests/tailcall.test index 35a7268..6b09cde 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -709,7 +709,7 @@ test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body { } -returnCodes 1 -result {namespace "::ns" not found} test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body { - proc tccrash args {llength $args} + proc tccrash args {llength $args} # Must be EXACTLY 254 for crash proc p {} [list tailcall tccrash {*}[lrepeat 254 x]] p -- cgit v0.12 From 0d8a08dbf1d766bcd778253199b782a231a202e7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 8 May 2023 09:35:57 +0000 Subject: Proposed fix for [96551aca55]: Avoid pointer arithmetic with NULL in FOREACH_STRUCT() --- generic/tclOOInt.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 725c4ce..8a19f74 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -589,12 +589,12 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); /* * A variation where the array is an array of structs. There's no issue with * possible NULLs; every element of the array will be iterated over and the - * varable set to a pointer to each of those elements in turn. + * variable set to a pointer to each of those elements in turn. * REQUIRES DECLARATION: int i; */ #define FOREACH_STRUCT(var,ary) \ - for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++) + if ((ary).num > 0) for(i=0; var=&((ary).list[i]), i<(ary).num; i++) /* * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS -- cgit v0.12 From af5bfc68cc1b458f1965b957bae448035b4c09a1 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 8 May 2023 11:35:45 +0000 Subject: Use Tcl_Size instead of size_t in two places in TclIndexEncode. --- generic/tclUtil.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index d883729..a5c1595 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3849,7 +3849,7 @@ TclIndexEncode( * error is raised. On 32-bit systems, indices in that range indicate * the position after the end and so do not raise an error. */ - if ((sizeof(int) != sizeof(size_t)) && + if ((sizeof(int) != sizeof(Tcl_Size)) && (wide > INT_MAX) && (wide < WIDE_MAX-1)) { /* 2(a,b) on 64-bit systems*/ goto rangeerror; @@ -3879,7 +3879,7 @@ TclIndexEncode( * indices in that range indicate the position before the beginning * and so do not raise an error. */ - if ((sizeof(int) != sizeof(size_t)) && + if ((sizeof(int) != sizeof(Tcl_Size)) && (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) { /* 1(c), 4(a,b) on 64-bit systems */ goto rangeerror; -- cgit v0.12 From 133b43a5217bb5e27bced051732443f474610b9c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 8 May 2023 13:43:56 +0000 Subject: Better version, keeping the (undocumented) behavior of 'i' initialization --- generic/tclOOInt.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 8a19f74..0b49359 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -590,11 +590,11 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * A variation where the array is an array of structs. There's no issue with * possible NULLs; every element of the array will be iterated over and the * variable set to a pointer to each of those elements in turn. - * REQUIRES DECLARATION: int i; + * REQUIRES DECLARATION: int i; See [96551aca55] for more FOREACH_STRUCT details. */ #define FOREACH_STRUCT(var,ary) \ - if ((ary).num > 0) for(i=0; var=&((ary).list[i]), i<(ary).num; i++) + i=0; if ((ary).num > 0) for(; var=&((ary).list[i]), i<(ary).num; i++) /* * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS -- cgit v0.12 From 8d076e6525835064d971940356ce83f9d7bd3d55 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 8 May 2023 14:08:44 +0000 Subject: Make TclLindexFlat() a litle more straightforward. --- generic/tclListObj.c | 55 ++++++++++++++++++++++++++++++++-------------------- generic/tclUtil.c | 4 ++-- 2 files changed, 36 insertions(+), 23 deletions(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 6cc933c..170dd69 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2656,6 +2656,7 @@ TclLindexFlat( Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that * represent the indices in the list. */ { + int status; Tcl_Size i; /* Handle ArithSeries as special case */ @@ -2684,24 +2685,13 @@ TclLindexFlat( for (i=0 ; i error. */ - break; + status = Tcl_ListObjLength(interp, listObj, &listLen); + if (status != TCL_OK) { + Tcl_DecrRefCount(listObj); + return NULL; } - LIST_ASSERT_TYPE(sublistCopy); - ListObjGetElements(sublistCopy, listLen, elemPtrs); if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, &index) == TCL_OK) { @@ -2715,20 +2705,43 @@ TclLindexFlat( if (TclGetIntForIndexM( interp, indexArray[i], TCL_SIZE_MAX - 1, &index) != TCL_OK) { - Tcl_DecrRefCount(sublistCopy); + Tcl_DecrRefCount(listObj); return NULL; } } + Tcl_DecrRefCount(listObj); TclNewObj(listObj); + Tcl_IncrRefCount(listObj); } else { + Tcl_Obj *itemObj; + /* + * Must set the internal rep again because it may have been + * changed by TclGetIntForIndexM. See test lindex-8.4. + */ + if (!TclHasInternalRep(listObj, &tclListType.objType)) { + status = SetListFromAny(interp, listObj); + if (status != TCL_OK) { + /* The list is not a list at all => error. */ + Tcl_DecrRefCount(listObj); + return NULL; + } + } + + ListObjGetElements(listObj, listLen, elemPtrs); + /* increment this reference count first before decrementing + * just in case they are the same Tcl_Obj + */ + itemObj = elemPtrs[index]; + Tcl_IncrRefCount(itemObj); + Tcl_DecrRefCount(listObj); /* Extract the pointer to the appropriate element. */ - listObj = elemPtrs[index]; + listObj = itemObj; } - Tcl_IncrRefCount(listObj); + } else { + Tcl_DecrRefCount(listObj); + listObj = NULL; } - Tcl_DecrRefCount(sublistCopy); } - return listObj; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index a5c1595..6112869 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3799,8 +3799,8 @@ TclIndexEncode( } /* * We passed 2*INT_MAX as the "end value" to GetWideForIndex. The computed - * index will in one of the following ranges that need to be distinguished - * for encoding purposes in the following code. + * index will be in one of the following ranges that need to be + * distinguished for encoding purposes in the following code. * (1) 0:INT_MAX when * (a) objPtr was a pure non-negative numeric value in that range * (b) objPtr was a numeric computation M+/-N with a result in that range -- cgit v0.12 From 77b454d1b27748f24d3ba5b31081e7ba17903ca7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 May 2023 09:51:47 +0000 Subject: size_t -> Tcl_Size (twice) --- generic/tcl.h | 2 +- macosx/tclMacOSXFCmd.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 1e33ba1..451acb7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2346,7 +2346,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); TclStubCall((void *)4))(argc, argv, appInitProc, interp) #if !defined(_WIN32) || !defined(UNICODE) #define Tcl_MainEx(argc, argv, appInitProc, interp) \ - (void)((const char *(*)(size_t, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ + (void)((const char *(*)(Tcl_Size, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ TclStubCall((void *)5))(argc, argv, appInitProc, interp) #endif #define Tcl_StaticLibrary(interp, pkgName, initProc, safeInitProc) \ diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index a30c8fb..e4604dc 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -640,7 +640,7 @@ SetOSTypeFromAny( int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); - size_t length; + Tcl_Size length; string = Tcl_GetStringFromObj(objPtr, &length); Tcl_UtfToExternalDStringEx(NULL, encoding, string, length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); -- cgit v0.12 From 2e02e1affdde86a1dd00fc78a73af5924c6d30a0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 May 2023 13:06:02 +0000 Subject: Remove useless type-casts. Backport some changes from 9.0 --- win/tclWinFile.c | 10 +++++----- win/tclWinReg.c | 8 ++++---- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index f0c46f9..adc1d7d 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -170,7 +170,7 @@ static int NativeWriteReparse(const WCHAR *LinkDirectory, static int NativeMatchType(int isDrive, DWORD attr, const WCHAR *nativeName, Tcl_GlobTypeData *types); static int WinIsDrive(const char *name, size_t nameLen); -static Tcl_Size WinIsReserved(const char *path); +static size_t WinIsReserved(const char *path); static Tcl_Obj * WinReadLink(const WCHAR *LinkSource); static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory); static int WinLink(const WCHAR *LinkSource, @@ -1245,7 +1245,7 @@ WinIsDrive( * (not any trailing :). */ -static Tcl_Size +static size_t WinIsReserved( const char *path) /* Path in UTF-8 */ { @@ -2579,14 +2579,14 @@ TclpObjNormalizePath( */ if (isDrive) { - Tcl_Size len = WinIsReserved(path); + size_t len = WinIsReserved(path); if (len > 0) { /* * Actually it does exist - COM1, etc. */ - Tcl_Size i; + size_t i; for (i=0 ; i