From 485d6fd8f006e6043ad90fc995bb1104fa81137e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Sep 2025 19:43:46 +0000 Subject: (backport) Use correct equality --- changes | 3 +++ library/http/http.tcl | 12 ++++++------ library/http/pkgIndex.tcl | 2 +- library/platform/platform.tcl | 2 +- tests/chanio.test | 2 +- tests/http.test | 6 +++--- tests/interp.test | 2 +- tests/io.test | 6 +++--- tests/socket.test | 2 +- tests/unixFCmd.test | 4 ++-- tests/winDde.test | 2 +- tools/regexpTestLib.tcl | 4 ++-- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 14 files changed, 29 insertions(+), 26 deletions(-) diff --git a/changes b/changes index 1c18591..97e7e2a 100644 --- a/changes +++ b/changes @@ -9422,4 +9422,7 @@ Many code fixes to avoid overflow or undefined behavior. Thanks chrstphrchvz. 2025-08-25 (new) [66cd46] support for MacOS Tahoe. Simplify for MacOS > 10 (nijtmans) => platform 1.1.0 +2025-09-15 (bug) Use correct equality + => http 2.9.9 + - (to be) Released 8.6.18, Apr ??, 2026 - details at https://core.tcl-lang.org/tcl/ - diff --git a/library/http/http.tcl b/library/http/http.tcl index 5dcd76c..c76d001 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.8 +package provide http 2.9.9 namespace eval http { # Allow resourcing to not clobber existing data @@ -1548,7 +1548,7 @@ proc http::Connected {token proto phost srvurl} { if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. - if {[TestForReplay $token write $err a]} { + if {[TestForReplay $token write $err a]} { return } else { Finish $token {failed to re-use socket} @@ -2381,7 +2381,7 @@ proc http::cleanup {token} { # # Side Effects # Sets the status of the connection, which unblocks -# the waiting geturl call +# the waiting geturl call proc http::Connect {token proto phost srvurl} { variable $token @@ -2625,7 +2625,7 @@ proc http::Event {sock token} { Log ^E$tk end of response headers - token $token # We have now read all headers # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3 - if { ($state(http) == "") + if { ($state(http) eq "") || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100) } { set state(state) "connecting" @@ -3548,7 +3548,7 @@ proc http::ReceiveChunked {chan command} { } # http::SplitCommaSeparatedFieldValue -- -# Return the individual values of a comma-separated field value. +# Return the individual values of a comma-separated field value. # # Arguments: # fieldValue Comma-separated header field value. @@ -3565,7 +3565,7 @@ proc http::SplitCommaSeparatedFieldValue {fieldValue} { # http::GetFieldValue -- -# Return the value of a header field. +# Return the value of a header field. # # Arguments: # headers Headers key-value list diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index bb742fd..935c20e 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.8 [list tclPkgSetup $dir http 2.9.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.9.9 [list tclPkgSetup $dir http 2.9.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl index 81a6b15..a275183 100644 --- a/library/platform/platform.tcl +++ b/library/platform/platform.tcl @@ -99,7 +99,7 @@ proc ::platform::generic {} { switch -glob -- $plat { windows { - if {$tcl_platform(platform) == "unix"} { + if {$tcl_platform(platform) eq "unix"} { set plat cygwin } else { set plat win32 diff --git a/tests/chanio.test b/tests/chanio.test index 54c566f..72cf07e 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -74,7 +74,7 @@ namespace eval ::tcl::test::io { set path(cat) [makeFile { set f stdin - if {$argv != ""} { + if {$argv ne ""} { set f [open [lindex $argv 0]] } chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A diff --git a/tests/http.test b/tests/http.test index 498621b..6406675 100644 --- a/tests/http.test +++ b/tests/http.test @@ -31,7 +31,7 @@ if {[catch {package require http 2} version]} { } } testConstraint http2.9.7 [package vsatisfies [package provide http] 2.9.7] -testConstraint http2.9.8 [package vsatisfies [package provide http] 2.9.8] +testConstraint http2.9.9 [package vsatisfies [package provide http] 2.9.9] proc bgerror {args} { global errorInfo @@ -474,10 +474,10 @@ test http-3.33 {http::geturl application/xml is text} -body { test http-3.34 {http::geturl -headers not a list} -returnCodes error -body { http::geturl http://test/t -headers \" -} -constraints http2.9.8 -result {Bad value for -headers ("), must be list} +} -constraints http2.9.9 -result {Bad value for -headers ("), must be list} test http-3.35 {http::geturl -headers not even number of elements} -returnCodes error -body { http::geturl http://test/t -headers {List Length 3} -} -constraints http2.9.8 -result {Bad value for -headers (List Length 3), number of list elements must be even} +} -constraints http2.9.9 -result {Bad value for -headers (List Length 3), number of list elements must be even} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] diff --git a/tests/interp.test b/tests/interp.test index d64fdd4..9f6924b 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -335,7 +335,7 @@ test interp-9.4 {testing aliases and namespace commands} { set res } {GLOBAL GLOBAL} -if {[info command nonexistent-command-in-parent] != ""} { +if {[info command nonexistent-command-in-parent] ne ""} { rename nonexistent-command-in-parent {} } diff --git a/tests/io.test b/tests/io.test index adffd89..ddb54c8 100644 --- a/tests/io.test +++ b/tests/io.test @@ -77,7 +77,7 @@ close $f set path(cat) [makeFile { set f stdin - if {$argv != ""} { + if {$argv ne ""} { set f [open [lindex $argv 0]] } fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A @@ -1784,7 +1784,7 @@ test io-13.12 {TranslateInputEOL: find EOF char in src} { # Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are # also testing channel table management. -if {[info commands testchannel] != ""} { +if {[info commands testchannel] ne ""} { set consoleFileNames [lsort [testchannel open]] } else { # just to avoid an error @@ -8263,7 +8263,7 @@ test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileeve incr counter set l [gets $s] - if {"$l" == ""} { + if {"$l" eq ""} { fileevent $s readable [namespace code "doit1 $s"] set after [after 1000 [namespace code newline]] } diff --git a/tests/socket.test b/tests/socket.test index 31d41ba..4668893 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -2380,7 +2380,7 @@ test socket-14.12 {[socket -async] background progress triggered by [fconfigure set s [socket -async localhost [randport]] for {set i 0} {$i < 50} {incr i} { set x [fconfigure $s -error] - if {$x != ""} break + if {$x ne ""} break after 200 } set x diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 8ac3ccc..55bc348 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -30,10 +30,10 @@ cd [temporaryDirectory] set user {} if {[testConstraint unix]} { catch {set user [exec whoami]} - if {$user == ""} { + if {$user eq ""} { catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} } - if {$user == ""} { + if {$user eq ""} { set user "root" } } diff --git a/tests/winDde.test b/tests/winDde.test index 3748046..6be65e2 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -60,7 +60,7 @@ proc createChildProcess {ddeServerName args} { # Define a restricted handler. proc Handler1 {cmd} { if {$cmd eq "stop"} {set ::done 1} - if {$cmd == ""} { + if {$cmd eq ""} { set cmd "null data" } puts $cmd ; flush stdout diff --git a/tools/regexpTestLib.tcl b/tools/regexpTestLib.tcl index a94d90f..f534a39 100644 --- a/tools/regexpTestLib.tcl +++ b/tools/regexpTestLib.tcl @@ -17,7 +17,7 @@ proc readInputFile {} { set len [string length $line] - if {($len > 0) && ([string index $line [expr {$len - 1}]] == "\\")} { + if {($len > 0) && ([string index $line [expr {$len - 1}]] eq "\\")} { if {[info exists lineArray(c$i)] == 0} { set lineArray(c$i) 1 } else { @@ -129,7 +129,7 @@ proc writeOutputFile {numLines fcn} { # copy comment string to output file and continue - if {[string index $currentLine 0] == "#"} { + if {[string index $currentLine 0] eq "#"} { puts $fileId $currentLine incr srcLineNum $lineArray(c$lineNum) incr lineNum diff --git a/unix/Makefile.in b/unix/Makefile.in index 2af82be..a504ea4 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -862,9 +862,9 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done - @echo "Installing package http 2.9.8 as a Tcl Module"; + @echo "Installing package http 2.9.9 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/8.6/http-2.9.8.tm" + "$(MODULE_INSTALL_DIR)/8.6/http-2.9.9.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ diff --git a/win/Makefile.in b/win/Makefile.in index b04350b..4f5a458 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -747,8 +747,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.8 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.8.tm"; + @echo "Installing package http 2.9.9 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.9.tm"; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12