summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-09-14 13:25:16 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-09-14 13:25:16 (GMT)
commit39aec08fb0bcd5aa7d51f44c3b79e21d8de33744 (patch)
tree2eeb4befb4f1ef1b1fe50521d45f6d78bd31fcb1
parentf073bc7484740398be58c99c4313c4c6202954f7 (diff)
parent66798b2c0139ffe530f62d2f3519859a451c6eaa (diff)
downloadtcl-39aec08fb0bcd5aa7d51f44c3b79e21d8de33744.zip
tcl-39aec08fb0bcd5aa7d51f44c3b79e21d8de33744.tar.gz
tcl-39aec08fb0bcd5aa7d51f44c3b79e21d8de33744.tar.bz2
Merge 8.7
-rw-r--r--.fossil-settings/binary-glob17
-rw-r--r--.gitattributes1
-rw-r--r--doc/interp.n8
-rw-r--r--generic/tclInterp.c4
-rw-r--r--library/http/http.tcl2
-rw-r--r--library/safe.tcl8
-rw-r--r--tests/chan.test2
-rw-r--r--tests/http11.test2
-rw-r--r--tests/httpTest.tcl10
-rw-r--r--tests/httpd11.tcl2
-rw-r--r--tests/obj.test2
-rw-r--r--tests/reg.test2
-rw-r--r--tests/socket.test2
-rw-r--r--tests/stringObj.test4
-rw-r--r--tests/thread.test4
-rw-r--r--tests/unload.test4
-rw-r--r--tests/winFCmd.test2
-rw-r--r--tools/mkdepend.tcl2
-rw-r--r--tools/uniParse.tcl4
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
}