diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-14 13:25:16 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-14 13:25:16 (GMT) |
| commit | 39aec08fb0bcd5aa7d51f44c3b79e21d8de33744 (patch) | |
| tree | 2eeb4befb4f1ef1b1fe50521d45f6d78bd31fcb1 | |
| parent | f073bc7484740398be58c99c4313c4c6202954f7 (diff) | |
| parent | 66798b2c0139ffe530f62d2f3519859a451c6eaa (diff) | |
| download | tcl-39aec08fb0bcd5aa7d51f44c3b79e21d8de33744.zip tcl-39aec08fb0bcd5aa7d51f44c3b79e21d8de33744.tar.gz tcl-39aec08fb0bcd5aa7d51f44c3b79e21d8de33744.tar.bz2 | |
Merge 8.7
| -rw-r--r-- | .fossil-settings/binary-glob | 17 | ||||
| -rw-r--r-- | .gitattributes | 1 | ||||
| -rw-r--r-- | doc/interp.n | 8 | ||||
| -rw-r--r-- | generic/tclInterp.c | 4 | ||||
| -rw-r--r-- | library/http/http.tcl | 2 | ||||
| -rw-r--r-- | library/safe.tcl | 8 | ||||
| -rw-r--r-- | tests/chan.test | 2 | ||||
| -rw-r--r-- | tests/http11.test | 2 | ||||
| -rw-r--r-- | tests/httpTest.tcl | 10 | ||||
| -rw-r--r-- | tests/httpd11.tcl | 2 | ||||
| -rw-r--r-- | tests/obj.test | 2 | ||||
| -rw-r--r-- | tests/reg.test | 2 | ||||
| -rw-r--r-- | tests/socket.test | 2 | ||||
| -rw-r--r-- | tests/stringObj.test | 4 | ||||
| -rw-r--r-- | tests/thread.test | 4 | ||||
| -rw-r--r-- | tests/unload.test | 4 | ||||
| -rw-r--r-- | tests/winFCmd.test | 2 | ||||
| -rw-r--r-- | tools/mkdepend.tcl | 2 | ||||
| -rw-r--r-- | tools/uniParse.tcl | 4 |
19 files changed, 33 insertions, 49 deletions
diff --git a/.fossil-settings/binary-glob b/.fossil-settings/binary-glob index a6eec26..7e8f357 100644 --- a/.fossil-settings/binary-glob +++ b/.fossil-settings/binary-glob @@ -1,20 +1,3 @@ -compat/zlib/win32/zdll.lib -compat/zlib/win32/zlib1.dll -compat/zlib/win64/zdll.lib -compat/zlib/win64/zlib1.dll -compat/zlib/win64/libz.dll.a -compat/zlib/zlib.3.pdf -compat/zlib/win32/zdll.lib -compat/zlib/win32/zlib1.dll -compat/zlib/win64/zdll.lib -compat/zlib/win64/zlib1.dll -compat/zlib/win64/libz.dll.a -compat/zlib/zlib.3.pdf -libtommath/win32/tommath.lib -libtommath/win32/libtommath.dll -libtommath/win64/tommath.lib -libtommath/win64/libtommath.dll -libtommath/win64/libtommath.dll.a *.a *.bmp *.dll diff --git a/.gitattributes b/.gitattributes index e9a67c8..8a49592 100644 --- a/.gitattributes +++ b/.gitattributes @@ -27,6 +27,7 @@ # Denote all files that are truly binary and should not be modified. *.a binary +*.bmp binary *.dll binary *.exe binary *.gif binary diff --git a/doc/interp.n b/doc/interp.n index 3a48e5e..732e9d3 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -659,9 +659,9 @@ including itself. .SH "ALIAS INVOCATION" .PP The alias mechanism has been carefully designed so that it can -be used safely when an untrusted script is executing -in a safe child and the target of the alias is a trusted -parent. The most important thing in guaranteeing safety is to +be used safely in an untrusted script which is being executed in a +safe interpreter even if the target of the alias is not a safe +interpreter. The most important thing in guaranteeing safety is to ensure that information passed from the child to the parent is never evaluated or substituted in the parent; if this were to occur, it would enable an evil script in the child to invoke @@ -743,7 +743,7 @@ To help avoid this problem, no substitutions or evaluations are applied to arguments of \fBinterp invokehidden\fR. .PP Safe interpreters are not allowed to invoke hidden commands in themselves -or in their descendants. This prevents safe children from gaining access to +or in their descendants. This prevents them from gaining access to hidden functionality in themselves or their descendants. .PP The set of hidden commands in an interpreter can be manipulated by a trusted diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 3883a07..2703849 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -123,7 +123,7 @@ typedef struct Target { * * NB: the flags field in the interp structure, used with SAFE_INTERP mask * denotes whether the interpreter is safe or not. Safe interpreters have - * restricted functionality, can only create safe child interpreters and can + * restricted functionality, can only create safe interpreters and can * only load safe extensions. */ @@ -3294,7 +3294,7 @@ Tcl_MakeSafe( */ /* - * No env array in a safe child. + * No env array in a safe interpreter. */ Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); diff --git a/library/http/http.tcl b/library/http/http.tcl index 4117f44..21d6671 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -2791,7 +2791,7 @@ proc http::Event {sock token} { # scan any list for "close". if {$tmpHeader in {close keep-alive}} { # The common cases, continue. - } elseif {[string first , $tmpHeader] == -1} { + } elseif {[string first , $tmpHeader] < 0} { # Not a comma-separated list, not "close", # therefore "keep-alive". set tmpHeader keep-alive diff --git a/library/safe.tcl b/library/safe.tcl index f0550a3..a9bb7f3 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -260,7 +260,7 @@ proc ::safe::interpConfigure {args} { # # safe::InterpCreate : doing the real job # -# This procedure creates a safe child and initializes it with the safe +# This procedure creates a safe interpreter and initializes it with the safe # base aliases. # NB: child name must be simple alphanumeric string, no spaces, no (), no # {},... {because the state array is stored as part of the name} @@ -576,7 +576,7 @@ proc ::safe::AddSubDirs {pathList} { return $res } -# This procedure deletes a safe child managed by Safe Tcl and cleans up +# This procedure deletes a safe interpreter managed by Safe Tcl and cleans up # associated state. # - The command will also delete non-Safe-Base interpreters. # - This is regrettable, but to avoid breaking existing code this should be @@ -1133,8 +1133,8 @@ proc ::safe::BadSubcommand {child command subcommand args} { # interpreters. proc ::safe::AliasEncodingSystem {child args} { try { - # Must not pass extra arguments; safe childs may not set the system - # encoding but they may read it. + # Must not pass extra arguments; safe interpreters may not set the + # system encoding but they may read it. if {[llength $args]} { return -code error -errorcode {TCL WRONGARGS} \ "wrong # args: should be \"encoding system\"" diff --git a/tests/chan.test b/tests/chan.test index 2ca0142..5d05935 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -173,7 +173,7 @@ test chan-16.9 {chan command: pending input subcommand} -setup { lappend ::chan-16.9-data $r $l $e $b $i - if {$r != -1 || $e || $l || !$b || $i > 128} { + if {$r >= 0 || $e || $l || !$b || $i > 128} { set data [read $sock $i] lappend ::chan-16.9-data [string range $data 0 2] lappend ::chan-16.9-data [string range $data end-2 end] diff --git a/tests/http11.test b/tests/http11.test index 7ca57f4..f243e56 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -19,7 +19,7 @@ variable httpd_output proc create_httpd {} { proc httpd_read {chan} { variable httpd_output - if {[gets $chan line] != -1} { + if {[gets $chan line] >= 0} { #puts stderr "read '$line'" set httpd_output $line } diff --git a/tests/httpTest.tcl b/tests/httpTest.tcl index 7491fb4..8a96d95 100644 --- a/tests/httpTest.tcl +++ b/tests/httpTest.tcl @@ -60,7 +60,7 @@ proc http::Log {args} { variable TestStartTimeInMs set time [expr {[clock milliseconds] - $TestStartTimeInMs}] set txt [list $time {*}$args] - if {[string first ^ $txt] != -1} { + if {[string first ^ $txt] >= 0} { ::httpTest::LogRecord $txt ::httpTest::Puts $txt } elseif {$::httpTest::testOptions(-verbose) > 1} { @@ -86,7 +86,7 @@ proc httpTest::LogRecord {txt} { puts stdout "Fix this call to Log in http-*.tm so it has ^ then\ a letter then a numeral." flush stdout - } elseif {$pos == -1} { + } elseif {$pos < 0} { # Called by mistake. } else { set letter [string index $txt [incr pos]] @@ -374,7 +374,7 @@ proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPip variable testOptions set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}] - if {$nextRetry == -1} { + if {$nextRetry < 0} { return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped] } set badTrans $notIncluded @@ -391,7 +391,7 @@ proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPip for {set i 1} {$i <= $n} {incr i} { set first [lsearch -exact $beforeTry [list A $i]] set last [lsearch -exact $beforeTry [list F $i]] - if {$first == -1} { + if {$first < 0} { set res "Transaction $i was not started in connection number $tryCount" # So lappend it to badTrans and don't include it in the call below of MostAnalysis. # append msg $res \n @@ -400,7 +400,7 @@ proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPip lappend badTrans $i } else { } - } elseif {$last == -1} { + } elseif {$last < 0} { set res "Transaction $i was started but unfinished in connection number $tryCount" # So lappend it to badTrans and don't include it in the call below of MostAnalysis. # append msg $res \n diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 0b02319..89590ec 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -237,7 +237,7 @@ proc Accept {chan addr port} { } proc Control {chan} { - if {[gets $chan line] != -1} { + if {[gets $chan line] >= 0} { if {[string trim $line] eq "quit"} { set ::forever 1 } diff --git a/tests/obj.test b/tests/obj.test index 8a74a05..e10cebf 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -34,7 +34,7 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes string } { set first [string first $t [testobj types]] - set r [expr {$r && ($first != -1)}] + set r [expr {$r && ($first >= 0)}] } set result $r } {1} diff --git a/tests/reg.test b/tests/reg.test index 4b65503..847da32 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -288,7 +288,7 @@ namespace eval RETest { set infoflags [TestInfoFlags $flags] set ccmd [list testregexp -about {*}$f $re] set nsub [expr {[llength $args] - 1}] - if {$nsub == -1} { + if {$nsub < 0} { # didn't tell us number of subexps set ccmd "lreplace \[$ccmd\] 0 0" set info [list $infoflags] diff --git a/tests/socket.test b/tests/socket.test index ee954d6..868c17a 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -248,7 +248,7 @@ if {$doTestsWithRemoteServer} { # Some tests are run only if we are doing testing against a remote server. testConstraint doTestsWithRemoteServer $doTestsWithRemoteServer if {!$doTestsWithRemoteServer} { - if {[string first s $::tcltest::verbose] != -1} { + if {[string first s $::tcltest::verbose] >= 0} { puts "Skipping tests with remote server. See tests/socket.test for" puts "information on how to run remote server." puts "Reason for not doing remote tests: $noRemoteTestReason" diff --git a/tests/stringObj.test b/tests/stringObj.test index 258e59a..e1b6c03 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -28,8 +28,8 @@ testConstraint fullutf [expr {[string length \U010000] == 1}] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] - set result [expr {$first != -1}] -} {1} + set result [expr {$first >= 0}] +} 1 test stringObj-2.1 {Tcl_NewStringObj} testobj { set result "" diff --git a/tests/thread.test b/tests/thread.test index 0a12285..0a35d1b 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -39,11 +39,11 @@ set threadSuperKillScript { proc getThreadErrorFromInfo { info } { set list [split $info \n] set idx [lsearch -glob $list "*eval*unwound*"] - if {$idx != -1} then { + if {$idx >= 0} then { return [lindex $list $idx] } set idx [lsearch -glob $list "*eval*canceled*"] - if {$idx != -1} then { + if {$idx >= 0} then { return [lindex $list $idx] } return ""; # some other error we do not care about. diff --git a/tests/unload.test b/tests/unload.test index 05a0104..815ff31 100644 --- a/tests/unload.test +++ b/tests/unload.test @@ -156,14 +156,14 @@ test unload-3.3 {unloading of a package that has never been loaded from a safe i unload [file join $testDir pkga$ext] {} child } -result {file "*" has never been loaded in this interpreter} test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup { - if {[lsearch -index 1 [info loaded child] Pkgb] == -1} { + if {[lsearch -index 1 [info loaded child] Pkgb] < 0} { load [file join $testDir pkgb$ext] pKgB child } } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkgb$ext] {} child } -result {file "*" cannot be unloaded under a safe interpreter} test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup { - if {[lsearch -index 1 [info loaded child] Pkgua] == -1} { + if {[lsearch -index 1 [info loaded child] Pkgua] < 0} { load [file join $testDir pkgua$ext] pkgua child } } -constraints [list $dll $loaded] -body { diff --git a/tests/winFCmd.test b/tests/winFCmd.test index f46dc5b..ef62cec 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -384,7 +384,7 @@ proc MakeFiles {dirname} { set f [open $filename w] close $f file stat $filename stat - if {[set n [lsearch -exact -integer $inodes $stat(ino)]] != -1} { + if {[set n [lsearch -exact -integer $inodes $stat(ino)]] >= 0} { return [list [file join $dirname Test$n] $filename] } lappend inodes $stat(ino) diff --git a/tools/mkdepend.tcl b/tools/mkdepend.tcl index 3d96a5e..b1ad076 100644 --- a/tools/mkdepend.tcl +++ b/tools/mkdepend.tcl @@ -88,7 +88,7 @@ proc readDepends {chan} { set line "" array set depends {} - while {[gets $chan line] != -1} { + while {[gets $chan line] >= 0} { if {[regexp {^#line [0-9]+ \"(.*)\"$} $line dummy fname] != 0} { set fname [file normalize $fname] if {![info exists target]} { diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl index a451096..545afc4 100644 --- a/tools/uniParse.tcl +++ b/tools/uniParse.tcl @@ -68,7 +68,7 @@ proc uni::getGroup {value} { variable groups set gIndex [lsearch -exact $groups $value] - if {$gIndex == -1} { + if {$gIndex < 0} { set gIndex [llength $groups] lappend groups $value } @@ -81,7 +81,7 @@ proc uni::addPage {info} { variable shift set pIndex [lsearch -exact $pages $info] - if {$pIndex == -1} { + if {$pIndex < 0} { set pIndex [llength $pages] lappend pages $info } |
