summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.fossil-settings/binary-glob17
-rw-r--r--.fossil-settings/crlf-glob3
-rw-r--r--.fossil-settings/ignore-glob14
-rw-r--r--.fossil-settings/manifest1
-rw-r--r--.gitattributes1
-rw-r--r--.gitignore21
-rw-r--r--.travis.yml91
-rw-r--r--ChangeLog.20002
-rw-r--r--compat/strstr.c10
-rw-r--r--compat/zlib/contrib/minizip/crypt.h6
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.sln2
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.sln2
-rw-r--r--compat/zlib/contrib/vstudio/vc12/zlibvc.sln238
-rw-r--r--compat/zlib/contrib/vstudio/vc14/zlibvc.sln238
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibvc.sln2
-rw-r--r--doc/CrtAlias.3 (renamed from doc/CrtSlave.3)89
-rw-r--r--doc/FileSystem.34
-rw-r--r--doc/GetIndex.319
-rw-r--r--doc/Limit.32
-rw-r--r--doc/Tcl.n5
-rw-r--r--doc/Tcl_Main.312
-rw-r--r--doc/Utf.310
-rw-r--r--doc/clock.n19
-rw-r--r--doc/dict.n14
-rw-r--r--doc/expr.n63
-rw-r--r--doc/http.n8
-rw-r--r--doc/info.n4
-rw-r--r--doc/interp.n248
-rw-r--r--doc/library.n11
-rw-r--r--doc/lsearch.n3
-rw-r--r--doc/pkgMkIndex.n4
-rw-r--r--doc/safe.n110
-rw-r--r--doc/string.n2
-rw-r--r--doc/tcltest.n22
-rw-r--r--doc/zlib.n22
-rw-r--r--generic/regexec.c2
-rw-r--r--generic/tcl.decls16
-rw-r--r--generic/tcl.h13
-rw-r--r--generic/tclAlloc.c2
-rw-r--r--generic/tclBasic.c124
-rw-r--r--generic/tclBinary.c4
-rw-r--r--generic/tclClock.c2
-rw-r--r--generic/tclCmdIL.c16
-rw-r--r--generic/tclCmdMZ.c8
-rw-r--r--generic/tclCompCmds.c55
-rw-r--r--generic/tclCompCmdsGR.c42
-rw-r--r--generic/tclCompCmdsSZ.c36
-rw-r--r--generic/tclCompExpr.c4
-rw-r--r--generic/tclCompile.c10
-rw-r--r--generic/tclCompile.h8
-rw-r--r--generic/tclDate.c274
-rw-r--r--generic/tclDecls.h58
-rw-r--r--generic/tclEncoding.c24
-rw-r--r--generic/tclEnsemble.c14
-rw-r--r--generic/tclEnv.c11
-rw-r--r--generic/tclEvent.c10
-rw-r--r--generic/tclExecute.c94
-rw-r--r--generic/tclFCmd.c4
-rw-r--r--generic/tclFileName.c8
-rw-r--r--generic/tclGetDate.y100
-rw-r--r--generic/tclIO.c6
-rw-r--r--generic/tclIO.h2
-rw-r--r--generic/tclIORChan.c8
-rw-r--r--generic/tclIOUtil.c6
-rw-r--r--generic/tclIndexObj.c10
-rw-r--r--generic/tclInt.decls4
-rw-r--r--generic/tclInt.h118
-rw-r--r--generic/tclIntDecls.h8
-rw-r--r--generic/tclInterp.c1107
-rw-r--r--generic/tclLink.c18
-rw-r--r--generic/tclListObj.c8
-rw-r--r--generic/tclLoad.c14
-rw-r--r--generic/tclNamesp.c34
-rw-r--r--generic/tclOO.c8
-rw-r--r--generic/tclOOBasic.c2
-rw-r--r--generic/tclOOInfo.c56
-rw-r--r--generic/tclOOInt.h4
-rw-r--r--generic/tclObj.c24
-rw-r--r--generic/tclOptimize.c2
-rw-r--r--generic/tclParse.c43
-rw-r--r--generic/tclPkg.c3
-rw-r--r--generic/tclProc.c11
-rw-r--r--generic/tclProcess.c12
-rw-r--r--generic/tclScan.c4
-rw-r--r--generic/tclStrToD.c89
-rw-r--r--generic/tclStringObj.c2
-rw-r--r--generic/tclStringRep.h6
-rw-r--r--generic/tclStubInit.c10
-rw-r--r--generic/tclTest.c300
-rw-r--r--generic/tclTestObj.c18
-rw-r--r--generic/tclTestProcBodyObj.c4
-rw-r--r--generic/tclThread.c22
-rw-r--r--generic/tclThreadStorage.c32
-rw-r--r--generic/tclThreadTest.c8
-rw-r--r--generic/tclTomMath.h41
-rw-r--r--generic/tclTomMathDecls.h2
-rw-r--r--generic/tclTrace.c6
-rw-r--r--generic/tclUtf.c279
-rw-r--r--generic/tclUtil.c486
-rw-r--r--generic/tclVar.c2
-rw-r--r--generic/tclZipfs.c80
-rw-r--r--generic/tclZlib.c276
-rw-r--r--library/auto.tcl18
-rw-r--r--library/clock.tcl4
-rw-r--r--library/cookiejar/cookiejar.tcl3
-rw-r--r--library/dde/pkgIndex.tcl6
-rw-r--r--library/http/http.tcl117
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/init.tcl49
-rw-r--r--library/install.tcl2
-rw-r--r--library/manifest.txt6
-rw-r--r--library/msgcat/msgcat.tcl22
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--library/opt/optparse.tcl6
-rw-r--r--library/opt/pkgIndex.tcl2
-rw-r--r--library/package.tcl12
-rw-r--r--[-rwxr-xr-x]library/reg/pkgIndex.tcl9
-rw-r--r--library/safe.tcl584
-rw-r--r--library/tclIndex2
-rw-r--r--library/tcltest/tcltest.tcl22
-rw-r--r--library/tm.tcl17
-rw-r--r--library/tzdata/Africa/Casablanca24
-rw-r--r--library/tzdata/Africa/El_Aaiun24
-rw-r--r--library/tzdata/America/Dawson161
-rw-r--r--library/tzdata/America/Godthab247
-rw-r--r--library/tzdata/America/Nuuk246
-rw-r--r--library/tzdata/America/Whitehorse161
-rw-r--r--library/tzdata/Asia/Shanghai2
-rw-r--r--library/word.tcl6
-rw-r--r--libtommath/libtommath_VS2008.sln2
-rw-r--r--macosx/Tcl.xcode/project.pbxproj6
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj6
-rw-r--r--macosx/tclMacOSXNotify.c127
-rw-r--r--pkgs/README2
-rw-r--r--tests/aaa_exit.test4
-rw-r--r--tests/all.tcl2
-rw-r--r--tests/append.test4
-rw-r--r--tests/appendComp.test10
-rw-r--r--tests/apply.test4
-rw-r--r--tests/assocd.test6
-rw-r--r--tests/async.test4
-rw-r--r--tests/auto-files.zipbin0 -> 4447 bytes
-rw-r--r--tests/auto0/auto1/file1.tcl3
-rw-r--r--tests/auto0/auto1/package1.tcl5
-rw-r--r--tests/auto0/auto1/pkgIndex.tcl11
-rw-r--r--tests/auto0/auto1/tclIndex9
-rw-r--r--tests/auto0/auto2/file2.tcl3
-rw-r--r--tests/auto0/auto2/package2.tcl5
-rw-r--r--tests/auto0/auto2/pkgIndex.tcl11
-rw-r--r--tests/auto0/auto2/tclIndex9
-rw-r--r--tests/auto0/modules/mod1/test1-1.0.tm5
-rw-r--r--tests/auto0/modules/mod2/test2-2.0.tm5
-rw-r--r--tests/auto0/modules/test0-0.5.tm5
-rw-r--r--tests/autoMkindex.test26
-rw-r--r--tests/basic.test12
-rw-r--r--tests/binary.test4
-rw-r--r--tests/case.test4
-rw-r--r--tests/chan.test6
-rw-r--r--tests/chanio.test263
-rw-r--r--tests/clock.test99
-rw-r--r--tests/cmdAH.test4
-rw-r--r--tests/cmdIL.test5
-rw-r--r--tests/cmdInfo.test6
-rw-r--r--tests/cmdMZ.test6
-rw-r--r--tests/compExpr-old.test5
-rw-r--r--tests/compExpr.test8
-rw-r--r--tests/compile.test7
-rw-r--r--tests/concat.test2
-rw-r--r--tests/config.test4
-rw-r--r--tests/coroutine.test20
-rw-r--r--tests/dcall.test6
-rw-r--r--tests/dict.test2
-rw-r--r--tests/dstring.test2
-rw-r--r--tests/encoding.test17
-rw-r--r--tests/env.test8
-rw-r--r--tests/error.test4
-rw-r--r--tests/eval.test2
-rw-r--r--tests/event.test8
-rw-r--r--tests/exec.test6
-rw-r--r--tests/execute.test106
-rw-r--r--tests/expr-old.test6
-rw-r--r--tests/expr.test4
-rw-r--r--tests/fCmd.test2
-rw-r--r--tests/fileName.test3
-rw-r--r--tests/fileSystem.test7
-rw-r--r--tests/fileSystemEncoding.test7
-rw-r--r--tests/for-old.test4
-rw-r--r--tests/for.test4
-rw-r--r--tests/foreach.test4
-rw-r--r--tests/format.test4
-rw-r--r--tests/get.test10
-rw-r--r--tests/history.test2
-rw-r--r--tests/http.test8
-rw-r--r--tests/http11.test252
-rw-r--r--tests/httpPipeline.test8
-rw-r--r--tests/httpTest.tcl12
-rw-r--r--tests/httpcookie.test6
-rw-r--r--tests/httpd11.tcl15
-rw-r--r--tests/if-old.test4
-rw-r--r--tests/if.test4
-rw-r--r--tests/incr-old.test4
-rw-r--r--tests/incr.test2
-rw-r--r--tests/indexObj.test4
-rw-r--r--tests/info.test22
-rw-r--r--tests/init.test12
-rw-r--r--tests/interp.test504
-rw-r--r--tests/io.test329
-rw-r--r--tests/ioCmd.test12
-rw-r--r--tests/ioTrans.test28
-rw-r--r--tests/iogt.test6
-rw-r--r--tests/join.test4
-rw-r--r--tests/lindex.test12
-rw-r--r--tests/link.test2
-rw-r--r--tests/linsert.test4
-rw-r--r--tests/list.test4
-rw-r--r--tests/listObj.test4
-rw-r--r--tests/llength.test4
-rw-r--r--tests/lmap.test2
-rw-r--r--tests/load.test6
-rw-r--r--tests/lpop.test4
-rw-r--r--tests/lrange.test4
-rw-r--r--tests/lrepeat.test4
-rw-r--r--tests/lreplace.test4
-rw-r--r--tests/lsearch.test6
-rw-r--r--tests/lset.test4
-rw-r--r--tests/lsetComp.test4
-rw-r--r--tests/macOSXFCmd.test4
-rw-r--r--tests/macOSXLoad.test4
-rw-r--r--tests/main.test10
-rw-r--r--tests/mathop.test4
-rw-r--r--tests/misc.test4
-rw-r--r--tests/msgcat.test7
-rw-r--r--tests/namespace-old.test2
-rw-r--r--tests/namespace.test107
-rw-r--r--tests/notify.test4
-rw-r--r--tests/nre.test4
-rw-r--r--tests/obj.test6
-rw-r--r--tests/oo.test158
-rw-r--r--tests/ooNext2.test12
-rw-r--r--tests/ooUtil.test6
-rw-r--r--tests/opt.test6
-rw-r--r--tests/package.test12
-rw-r--r--tests/parse.test24
-rw-r--r--tests/parseExpr.test6
-rw-r--r--tests/parseOld.test6
-rw-r--r--tests/pid.test4
-rw-r--r--tests/pkgMkIndex.test28
-rw-r--r--tests/platform.test2
-rw-r--r--tests/proc-old.test4
-rw-r--r--tests/proc.test8
-rw-r--r--tests/process.test4
-rw-r--r--tests/pwd.test4
-rw-r--r--tests/reg.test7
-rw-r--r--tests/regexp.test13
-rw-r--r--tests/regexpComp.test4
-rw-r--r--tests/registry.test4
-rw-r--r--tests/rename.test4
-rw-r--r--tests/resolver.test6
-rw-r--r--tests/result.test6
-rw-r--r--tests/safe-stock.test248
-rw-r--r--tests/safe-zipfs.test729
-rw-r--r--tests/safe.test952
-rw-r--r--tests/scan.test12
-rw-r--r--tests/security.test2
-rw-r--r--tests/set-old.test4
-rw-r--r--tests/set.test4
-rw-r--r--tests/socket.test43
-rw-r--r--tests/split.test4
-rw-r--r--tests/stack.test6
-rw-r--r--tests/string.test35
-rw-r--r--tests/stringObj.test8
-rw-r--r--tests/subst.test18
-rw-r--r--tests/switch.test2
-rw-r--r--tests/tailcall.test4
-rw-r--r--tests/tcltest.test170
-rw-r--r--tests/tcltests.tcl2
-rw-r--r--tests/thread.test10
-rw-r--r--tests/timer.test16
-rw-r--r--tests/tm.test3
-rw-r--r--tests/trace.test16
-rw-r--r--tests/unixFCmd.test4
-rw-r--r--tests/unixFile.test4
-rw-r--r--tests/unixForkEvent.test6
-rw-r--r--tests/unixInit.test6
-rw-r--r--tests/unixNotfy.test4
-rw-r--r--tests/unknown.test6
-rw-r--r--tests/unload.test8
-rw-r--r--tests/uplevel.test4
-rw-r--r--tests/upvar.test4
-rw-r--r--tests/utf.test1239
-rw-r--r--tests/util.test7
-rw-r--r--tests/var.test8
-rw-r--r--tests/while-old.test4
-rw-r--r--tests/while.test2
-rw-r--r--tests/winConsole.test4
-rw-r--r--tests/winDde.test183
-rw-r--r--tests/winFCmd.test6
-rw-r--r--tests/winFile.test7
-rw-r--r--tests/winNotify.test4
-rw-r--r--tests/winPipe.test6
-rw-r--r--tests/winTime.test4
-rw-r--r--tests/zipfs.test2
-rw-r--r--tests/zlib.test86
-rwxr-xr-xtools/checkLibraryDoc.tcl1
-rw-r--r--tools/encoding/Makefile12
-rw-r--r--tools/encoding/big5.txt14
-rw-r--r--tools/encoding/jis0212.txt4
-rw-r--r--tools/encoding/ksc5601.txt6
-rw-r--r--tools/encoding/macCentEuro.txt2
-rw-r--r--tools/encoding/macCroatian.txt2
-rw-r--r--tools/encoding/macCyrillic.txt2
-rw-r--r--tools/encoding/macGreek.txt2
-rw-r--r--tools/encoding/macIceland.txt2
-rw-r--r--tools/encoding/macRoman.txt2
-rw-r--r--tools/encoding/macTurkish.txt2
-rw-r--r--tools/encoding/shiftjis.txt2
-rw-r--r--tools/encoding/tis-620.txt2
-rw-r--r--tools/mkdepend.tcl4
-rwxr-xr-xtools/tcltk-man2html.tcl1
-rw-r--r--tools/uniParse.tcl4
-rw-r--r--unix/Makefile.in35
-rwxr-xr-xunix/configure24
-rw-r--r--unix/configure.ac3
-rwxr-xr-xunix/installManPage2
-rw-r--r--unix/tcl.m420
-rw-r--r--unix/tclConfig.h.in32
-rw-r--r--unix/tclConfig.sh.in3
-rw-r--r--unix/tclUnixCompat.c6
-rw-r--r--unix/tclUnixInit.c2
-rw-r--r--unix/tclUnixThrd.c68
-rw-r--r--win/Makefile.in14
-rwxr-xr-xwin/configure50
-rw-r--r--win/configure.ac27
-rw-r--r--win/makefile.vc1
-rw-r--r--win/nmakehlp.c2
-rw-r--r--win/rules.vc18
-rw-r--r--win/tcl.dsp2
-rw-r--r--win/tcl.m434
-rw-r--r--win/tclConfig.sh.in7
-rw-r--r--win/tclWinInit.c21
-rw-r--r--win/tclWinNotify.c4
-rw-r--r--win/tclWinPort.h7
-rw-r--r--win/tclWinSock.c2
-rw-r--r--win/tclWinTest.c6
-rw-r--r--win/tclWinThrd.c56
345 files changed, 8663 insertions, 5667 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/.fossil-settings/crlf-glob b/.fossil-settings/crlf-glob
index 56f3a03..ebd0093 100644
--- a/.fossil-settings/crlf-glob
+++ b/.fossil-settings/crlf-glob
@@ -1,6 +1,7 @@
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
+compat/zlib/contrib/vstudio/*/*.sln
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
@@ -16,4 +17,4 @@ win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
-win/tcl.hpj.in \ No newline at end of file
+win/tcl.hpj.in
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
index 8ad2c80..651d616 100644
--- a/.fossil-settings/ignore-glob
+++ b/.fossil-settings/ignore-glob
@@ -1,6 +1,7 @@
*.a
*.dll
*.dylib
+*.dylib.E
*.exe
*.exp
*.la
@@ -13,6 +14,7 @@
*.sl
*.so
*/Makefile
+*/autom4te.cache
*/config.cache
*/config.log
*/config.status
@@ -30,7 +32,7 @@ libtommath/pretty.build
libtommath/tommath.src
libtommath/*.log
libtommath/*.pdf
-libtommath/gen.pl
+libtommath/*.pl
libtommath/*.sh
libtommath/doc/*
libtommath/tombc/*
@@ -42,10 +44,19 @@ libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
+macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
+unix/dltest/*.bundle
+unix/dltest/*.dll
+unix/dltest/*.dylib
+unix/dltest/*.o
+unix/dltest/*.sl
+unix/dltest/*.so
unix/tcl.pc
unix/tclIndex
+unix/Tcl-Info.plist
+unix/Tclsh-Info.plist
unix/pkgs/*
win/Debug*
win/Release*
@@ -53,4 +64,5 @@ win/*.manifest
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
+win/nmakehlp.out
win/nmhlp-out.txt
diff --git a/.fossil-settings/manifest b/.fossil-settings/manifest
new file mode 100644
index 0000000..4ae8ef0
--- /dev/null
+++ b/.fossil-settings/manifest
@@ -0,0 +1 @@
+u
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/.gitignore b/.gitignore
index 62a7a5a..33579cf 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,8 @@
*.a
+*.bundle
*.dll
*.dylib
+*.dylib.E
*.exe
*.exp
*.lib
@@ -10,10 +12,18 @@
*.res
*.sl
*.so
-*/Makefile
-*/config.cache
-*/config.log
-*/config.status
+.fslckout
+Makefile
+Tcl-Info.plist
+Tclsh-Info.plist
+autom4te.cache
+config.cache
+config.log
+config.status
+config.status.lineno
+html
+manifest.uuid
+_FOSSIL_
*/tclConfig.sh
*/tclsh*
*/tcltest*
@@ -21,7 +31,6 @@
*/version.vc
*/libtcl.vfs
*/libtcl_*.zip
-html
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
@@ -40,6 +49,7 @@ libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
+macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/tcl.pc
@@ -51,4 +61,5 @@ win/*.manifest
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
+win/nmakehlp.out
win/nmhlp-out.txt
diff --git a/.travis.yml b/.travis.yml
index 50eb658..9ccfc25 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -1,4 +1,3 @@
-sudo: false
language: c
addons:
apt:
@@ -10,50 +9,46 @@ addons:
- gcc-mingw-w64-i686
- gcc-mingw-w64-x86-64
- gcc-multilib
- homebrew:
- packages:
- - libtommath
- update: true
-matrix:
+jobs:
include:
# Testing on Linux with various compilers
- name: "Linux/GCC/Shared"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- name: "Linux/GCC/Shared: UTF_MAX=4"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT=CFLAGS=-DTCL_UTF_MAX=4
- name: "Linux/GCC/Shared: NO_DEPRECATED"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
- name: "Linux/GCC/Static"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
- name: "Linux/GCC/Debug"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols"
- name: "Linux/GCC/Mem-Debug"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
@@ -61,7 +56,7 @@ matrix:
# C++ build.
- name: "Linux/G++/Shared"
os: linux
- dist: bionic
+ dist: focal
compiler: g++
env:
- BUILD_DIR=unix
@@ -69,7 +64,7 @@ matrix:
# Older versions of GCC...
- name: "Linux/GCC 7/Shared"
os: linux
- dist: bionic
+ dist: focal
compiler: gcc-7
addons:
apt:
@@ -106,7 +101,7 @@ matrix:
# Clang
- name: "Linux/Clang/Shared"
os: linux
- dist: bionic
+ dist: focal
compiler: clang
env:
- BUILD_DIR=unix
@@ -119,29 +114,29 @@ matrix:
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
- name: "Linux/Clang/Static"
os: linux
- dist: bionic
+ dist: focal
compiler: clang
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
- name: "Linux/Clang/Debug"
os: linux
- dist: bionic
+ dist: focal
compiler: clang
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols"
- name: "Linux/Clang/Mem-Debug"
os: linux
- dist: bionic
+ dist: focal
compiler: clang
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols=mem"
# Testing on Mac, various styles
- - name: "macOS/Xcode 11.4/Shared"
+ - name: "macOS/Clang/Xcode 11.7/Shared"
os: osx
- osx_image: xcode11.4
+ osx_image: xcode11.7
env:
- BUILD_DIR=macosx
install: []
@@ -149,57 +144,64 @@ matrix:
- make all
# The styles=develop avoids some weird problems on OSX
- make test styles=develop
- - name: "macOS/Xcode 11.4/Shared/Unix-like"
+ - name: "macOS/Clang/Xcode 11.7/Shared/Unix-like"
+ os: osx
+ osx_image: xcode11.7
+ env:
+ - BUILD_DIR=unix
+ - name: "macOS/Clang/Xcode 11.7/Shared/libtommath"
+ os: osx
+ osx_image: xcode11.7
+ env:
+ - BUILD_DIR=macosx
+ install: []
+ script: *mactest
+ addons:
+ homebrew:
+ packages:
+ - libtommath
+ - name: "macOS/Clang++/Xcode 11.7/Shared"
os: osx
- osx_image: xcode11.4
+ osx_image: xcode11.7
env:
- BUILD_DIR=unix
+ - CFGOPT="CC=clang++ --enable-framework CFLAGS=-Dregister=dont+use+register CPPFLAGS=-D__private_extern__=extern"
+ script:
+ - make all tcltest
# Older MacOS versions
- - name: "macOS/Xcode 11/Shared"
+ - name: "macOS/Clang/Xcode 11/Shared"
os: osx
osx_image: xcode11
env:
- BUILD_DIR=macosx
install: []
script: *mactest
- - name: "macOS/Xcode 10/Shared"
+ - name: "macOS/Clang/Xcode 10/Shared"
os: osx
osx_image: xcode10.3
env:
- BUILD_DIR=macosx
install: []
script: *mactest
- addons:
- homebrew:
- packages:
- - libtommath
- - name: "macOS/Xcode 9/Shared"
+ - name: "macOS/Clang/Xcode 9/Shared"
os: osx
osx_image: xcode9.2
env:
- BUILD_DIR=macosx
install: []
script: *mactest
- addons:
- homebrew:
- packages:
- - libtommath
- - name: "macOS/Xcode 8/Shared"
+ - name: "macOS/Clang/Xcode 8/Shared"
os: osx
osx_image: xcode8.3
env:
- BUILD_DIR=macosx
install: []
script: *mactest
- addons:
- homebrew:
- packages:
- - libtommath
# 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: bionic
+ dist: focal
compiler: x86_64-w64-mingw32-gcc
env:
- BUILD_DIR=win
@@ -213,7 +215,7 @@ matrix:
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows-32/GCC/Shared/no test"
os: linux
- dist: bionic
+ dist: focal
compiler: i686-w64-mingw32-gcc
env:
- BUILD_DIR=win
@@ -438,6 +440,15 @@ matrix:
- BUILD_DIR=win
- CFGOPT="--enable-symbols=mem"
before_install: *makepreinst
+# "make dist" only
+ - name: "Linux: make dist"
+ os: linux
+ dist: focal
+ compiler: gcc
+ env:
+ - BUILD_DIR=unix
+ script:
+ - make dist
before_install:
- cd ${BUILD_DIR}
install:
diff --git a/ChangeLog.2000 b/ChangeLog.2000
index 5b62351..7e78c19 100644
--- a/ChangeLog.2000
+++ b/ChangeLog.2000
@@ -1779,7 +1779,7 @@
* generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all]
[Bug: 4981].
- * tests/*.test: Changed all occurances of "namespace import
+ * tests/*.test: Changed all occurrences of "namespace import
::tcltest" to "namespace import -force ::tcltest" [Bug: 3948].
2000-04-09 Brent Welch <welch@scriptics.com>
diff --git a/compat/strstr.c b/compat/strstr.c
index 206dca9..35386d0 100644
--- a/compat/strstr.c
+++ b/compat/strstr.c
@@ -36,10 +36,10 @@
char *
strstr(
- char *string, /* String to search. */
- char *substring) /* Substring to try to find in string. */
+ const char *string, /* String to search. */
+ const char *substring) /* Substring to try to find in string. */
{
- char *a, *b;
+ const char *a, *b;
/*
* First scan quickly through the two strings looking for a
@@ -49,7 +49,7 @@ strstr(
b = substring;
if (*b == 0) {
- return string;
+ return (char *)string;
}
for ( ; *string != 0; string += 1) {
if (*string != *b) {
@@ -58,7 +58,7 @@ strstr(
a = string;
while (1) {
if (*b == 0) {
- return string;
+ return (char *)string;
}
if (*a++ != *b++) {
break;
diff --git a/compat/zlib/contrib/minizip/crypt.h b/compat/zlib/contrib/minizip/crypt.h
index 62dcf77..4da804a 100644
--- a/compat/zlib/contrib/minizip/crypt.h
+++ b/compat/zlib/contrib/minizip/crypt.h
@@ -29,12 +29,6 @@
#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8))
-#ifdef Z_U4
- typedef Z_U4 z_crc_t;
-#else
- typedef unsigned long z_crc_t;
-#endif
-
/***********************************************************************
* Return the next byte in the pseudo-random sequence
*/
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.sln b/compat/zlib/contrib/vstudio/vc10/zlibvc.sln
index 6f6ffd5..6953136 100644
--- a/compat/zlib/contrib/vstudio/vc10/zlibvc.sln
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.sln
@@ -1,4 +1,4 @@
-
+
Microsoft Visual Studio Solution File, Format Version 11.00
# Visual Studio 2010
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.sln b/compat/zlib/contrib/vstudio/vc11/zlibvc.sln
index 9fcbafd..7e340e6 100644
--- a/compat/zlib/contrib/vstudio/vc11/zlibvc.sln
+++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.sln
@@ -1,4 +1,4 @@
-
+
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 2012
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
diff --git a/compat/zlib/contrib/vstudio/vc12/zlibvc.sln b/compat/zlib/contrib/vstudio/vc12/zlibvc.sln
index dcda229..93b13c1 100644
--- a/compat/zlib/contrib/vstudio/vc12/zlibvc.sln
+++ b/compat/zlib/contrib/vstudio/vc12/zlibvc.sln
@@ -1,119 +1,119 @@
-
-Microsoft Visual Studio Solution File, Format Version 12.00
-# Visual Studio 2013
-VisualStudioVersion = 12.0.40629.0
-MinimumVisualStudioVersion = 10.0.40219.1
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
-EndProject
-Global
- GlobalSection(SolutionConfigurationPlatforms) = preSolution
- Debug|Itanium = Debug|Itanium
- Debug|Win32 = Debug|Win32
- Debug|x64 = Debug|x64
- Release|Itanium = Release|Itanium
- Release|Win32 = Release|Win32
- Release|x64 = Release|x64
- ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
- ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
- ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
- EndGlobalSection
- GlobalSection(ProjectConfigurationPlatforms) = postSolution
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
- EndGlobalSection
- GlobalSection(SolutionProperties) = preSolution
- HideSolutionNode = FALSE
- EndGlobalSection
-EndGlobal
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 2013
+VisualStudioVersion = 12.0.40629.0
+MinimumVisualStudioVersion = 10.0.40219.1
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Itanium = Debug|Itanium
+ Debug|Win32 = Debug|Win32
+ Debug|x64 = Debug|x64
+ Release|Itanium = Release|Itanium
+ Release|Win32 = Release|Win32
+ Release|x64 = Release|x64
+ ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
+ ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
+ ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc14/zlibvc.sln b/compat/zlib/contrib/vstudio/vc14/zlibvc.sln
index 6f4a107..0f29237 100644
--- a/compat/zlib/contrib/vstudio/vc14/zlibvc.sln
+++ b/compat/zlib/contrib/vstudio/vc14/zlibvc.sln
@@ -1,119 +1,119 @@
-
-Microsoft Visual Studio Solution File, Format Version 12.00
-# Visual Studio 14
-VisualStudioVersion = 14.0.25420.1
-MinimumVisualStudioVersion = 10.0.40219.1
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
-EndProject
-Global
- GlobalSection(SolutionConfigurationPlatforms) = preSolution
- Debug|Itanium = Debug|Itanium
- Debug|Win32 = Debug|Win32
- Debug|x64 = Debug|x64
- Release|Itanium = Release|Itanium
- Release|Win32 = Release|Win32
- Release|x64 = Release|x64
- ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
- ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
- ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
- EndGlobalSection
- GlobalSection(ProjectConfigurationPlatforms) = postSolution
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
- EndGlobalSection
- GlobalSection(SolutionProperties) = preSolution
- HideSolutionNode = FALSE
- EndGlobalSection
-EndGlobal
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 14
+VisualStudioVersion = 14.0.25420.1
+MinimumVisualStudioVersion = 10.0.40219.1
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Itanium = Debug|Itanium
+ Debug|Win32 = Debug|Win32
+ Debug|x64 = Debug|x64
+ Release|Itanium = Release|Itanium
+ Release|Win32 = Release|Win32
+ Release|x64 = Release|x64
+ ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
+ ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
+ ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc9/zlibvc.sln b/compat/zlib/contrib/vstudio/vc9/zlibvc.sln
index b482967..20568fa 100644
--- a/compat/zlib/contrib/vstudio/vc9/zlibvc.sln
+++ b/compat/zlib/contrib/vstudio/vc9/zlibvc.sln
@@ -1,4 +1,4 @@
-
+
Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
diff --git a/doc/CrtSlave.3 b/doc/CrtAlias.3
index b8ac421..92f9b0c 100644
--- a/doc/CrtSlave.3
+++ b/doc/CrtAlias.3
@@ -4,11 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateAlias 3 7.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
-Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
+Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_CreateSlave, Tcl_GetChild, Tcl_GetSlave, Tcl_GetParent, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -20,31 +20,40 @@ int
\fBTcl_MakeSafe\fR(\fIinterp\fR)
.sp
Tcl_Interp *
-\fBTcl_CreateSlave\fR(\fIinterp, slaveName, isSafe\fR)
+\fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR)
.sp
Tcl_Interp *
-\fBTcl_GetSlave\fR(\fIinterp, slaveName\fR)
+\fBTcl_CreateSlave\fR(\fIinterp, name, isSafe\fR)
+.sp
+Tcl_Interp *
+\fBTcl_GetSlave\fR(\fIinterp, name\fR)
+.sp
+Tcl_Interp *
+\fBTcl_GetChild\fR(\fIinterp, name\fR)
.sp
Tcl_Interp *
\fBTcl_GetMaster\fR(\fIinterp\fR)
.sp
+Tcl_Interp *
+\fBTcl_GetParent\fR(\fIinterp\fR)
+.sp
int
-\fBTcl_GetInterpPath\fR(\fIaskingInterp, slaveInterp\fR)
+\fBTcl_GetInterpPath\fR(\fIinterp, childInterp\fR)
.sp
int
-\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
+\fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
argc, argv\fR)
.sp
int
-\fBTcl_CreateAliasObj\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
+\fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
objc, objv\fR)
.sp
int
-\fBTcl_GetAlias\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
+\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
argcPtr, argvPtr\fR)
.sp
int
-\fBTcl_GetAliasObj\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
+\fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
objcPtr, objvPtr\fR)
.sp
int
@@ -56,17 +65,17 @@ int
.AS "const char *const" **targetInterpPtr out
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
-.AP "const char" *slaveName in
-Name of slave interpreter to create or manipulate.
+.AP "const char" *name in
+Name of child interpreter to create or manipulate.
.AP int isSafe in
If non-zero, a
.QW safe
-slave that is suitable for running untrusted code
-is created, otherwise a trusted slave is created.
-.AP Tcl_Interp *slaveInterp in
+child that is suitable for running untrusted code
+is created, otherwise a trusted child is created.
+.AP Tcl_Interp *childInterp in
Interpreter to use for creating the source command for an alias (see
below).
-.AP "const char" *slaveCmd in
+.AP "const char" *childCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
@@ -121,17 +130,19 @@ interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the interpreter's result contains an error message.
.PP
-\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
-It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
-allows \fIinterp\fR to manipulate the new slave.
-If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
+\fBTcl_CreateChild\fR creates a new interpreter as a child of \fIinterp\fR.
+It also creates a child command named \fIname\fR in \fIinterp\fR which
+allows \fIinterp\fR to manipulate the new child.
+If \fIisSafe\fR is zero, the command creates a trusted child in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
.QW safe
-slave in which Tcl code has access only to set of Tcl commands defined as
+child in which Tcl code has access only to set of Tcl commands defined as
.QW "Safe Tcl" ;
see the manual entry for the Tcl \fBinterp\fR command for details.
-If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
+If the creation of the new child interpreter failed, \fBNULL\fR is returned.
+.PP
+\fBTcl_CreateSlave\fR is a synonym for \fBTcl_CreateChild\fR.
.PP
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
.QW safe
@@ -147,34 +158,38 @@ from \fIinterp\fR. However, it cannot know what parts of an extension
or application are safe and does not make any attempt to remove those
parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR.
Callers will want to take care with their use of \fBTcl_MakeSafe\fR
-to avoid false claims of safety. For many situations, \fBTcl_CreateSlave\fR
+to avoid false claims of safety. For many situations, \fBTcl_CreateChild\fR
may be a better choice, since it creates interpreters in a known-safe state.
.PP
-\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of
-\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
-If no such slave interpreter exists, \fBNULL\fR is returned.
+\fBTcl_GetChild\fR returns a pointer to a child interpreter of
+\fIinterp\fR. The child interpreter is identified by \fIname\fR.
+If no such child interpreter exists, \fBNULL\fR is returned.
.PP
-\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
-\fIinterp\fR. If \fIinterp\fR has no master (it is a
+\fBTcl_GetSlave\fR is a synonym for \fBTcl_GetChild\fR.
+.PP
+\fBTcl_GetParent\fR returns a pointer to the parent interpreter of
+\fIinterp\fR. If \fIinterp\fR has no parent (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
-\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
-the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
-\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
+\fBTcl_GetMaster\fR is a synonym for \fBTcl_GetParent\fR.
+.PP
+\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
+the relative path between \fIinterp\fR and \fIchildInterp\fR;
+\fIchildInterp\fR must be a child of \fIinterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
-result of \fIaskingInterp\fR.
+result of \fIinterp\fR.
.PP
-\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
-\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
+\fBTcl_CreateAlias\fR creates a command named \fIchildCmd\fR in
+\fIchildInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
-invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
+invocation of \fIchildCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
it fails; in that case, an error message is left in the value result
-of \fIslaveInterp\fR.
+of \fIchildInterp\fR.
Note that there are no restrictions on the ancestry relationship (as
-created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
+created by \fBTcl_CreateChild\fR) between \fIchildInterp\fR and
\fItargetInterp\fR. Any two interpreters can be used, without any
restrictions on how they are related.
.PP
@@ -233,4 +248,4 @@ interp
.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
-master, slave
+parent, child
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index 3b50232..6703638 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -1340,11 +1340,11 @@ is considered to be owned by the filesystem (not by Tcl's core), but
should be given a reference count for Tcl. Tcl will use the contents of the
list and then decrement that reference count. This allows filesystems to
choose whether they actually want to retain a
-.QW "master list"
+.QW "global list"
of volumes
or not (if not, they generate the list on the fly and pass it to Tcl
with a reference count of 1 and then forget about the list, if yes, then
-they simply increment the reference count of their master list and pass it
+they simply increment the reference count of their global list and pass it
to Tcl which will copy the contents and then decrement the count back
to where it was).
.PP
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index 17a31d4..8591c56 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -27,19 +27,22 @@ Interpreter to use for error reporting; if NULL, then no message is
provided on errors.
.AP Tcl_Obj *objPtr in/out
The string value of this value is used to search through \fItablePtr\fR.
-The internal representation is modified to hold the index of the matching
+If the \fBTCL_INDEX_TEMP_TABLE\fR flag is not specified,
+the internal representation is modified to hold the index of the matching
table entry.
.AP "const char *const" *tablePtr in
An array of null-terminated strings. The end of the array is marked
by a NULL string pointer.
-Note that references to the \fItablePtr\fR may be retained in the
+Note that, unless the \fBTCL_INDEX_TEMP_TABLE\fR flag is specified,
+references to the \fItablePtr\fR may be retained in the
internal representation of \fIobjPtr\fR, so this should represent the
address of a statically-allocated array.
.AP "const void" *structTablePtr in
An array of arbitrary type, typically some \fBstruct\fR type.
The first member of the structure must be a null-terminated string.
The size of the structure is given by \fIoffset\fR.
-Note that references to the \fIstructTablePtr\fR may be retained in the
+Note that, unless the \fBTCL_INDEX_TEMP_TABLE\fR flag is specified,
+references to the \fIstructTablePtr\fR may be retained in the
internal representation of \fIobjPtr\fR, so this should represent the
address of a statically-allocated array of structures.
.AP int offset in
@@ -50,7 +53,8 @@ Null-terminated string describing what is being looked up, such as
\fBoption\fR. This string is included in error messages.
.AP int flags in
OR-ed combination of bits providing additional information for
-operation. The only bit that is currently defined is \fBTCL_EXACT\fR.
+operation. The only bits that are currently defined are \fBTCL_EXACT\fR
+and \fBTCL_INDEX_TEMP_TABLE\fR.
.AP int *indexPtr out
The index of the string in \fItablePtr\fR that matches the value of
\fIobjPtr\fR is returned here.
@@ -76,7 +80,8 @@ error message to indicate what was being looked up. For example,
if \fImsg\fR is \fBoption\fR the error message will have a form like
.QW "\fBbad option \N'34'firt\N'34': must be first, second, or third\fR" .
.PP
-If \fBTcl_GetIndexFromObj\fR completes successfully it modifies the
+If the \fBTCL_INDEX_TEMP_TABLE\fR was not specified, when
+\fBTcl_GetIndexFromObj\fR completes successfully it modifies the
internal representation of \fIobjPtr\fR to hold the address of
the table and the index of the matching entry. If \fBTcl_GetIndexFromObj\fR
is invoked again with the same \fIobjPtr\fR and \fItablePtr\fR
@@ -84,7 +89,9 @@ arguments (e.g. during a reinvocation of a Tcl command), it returns
the matching index immediately without having to redo the lookup
operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries
in \fItablePtr\fR are static: they must not change between
-invocations. If the value of \fIobjPtr\fR is the empty string,
+invocations. This caching mechanism can be disallowed by specifying
+the \fBTCL_INDEX_TEMP_TABLE\fR flag.
+If the value of \fIobjPtr\fR is the empty string,
\fBTcl_GetIndexFromObj\fR will treat it as a non-matching value
and return \fBTCL_ERROR\fR.
.PP
diff --git a/doc/Limit.3 b/doc/Limit.3
index 5939a80..3d202fc 100644
--- a/doc/Limit.3
+++ b/doc/Limit.3
@@ -116,7 +116,7 @@ execution of the callbacks is unspecified) execution in the limited
interpreter is stopped by raising an error and setting a flag that
prevents the \fBcatch\fR command in that interpreter from trapping
that error. It is up to the context that started execution in that
-interpreter (typically a master interpreter) to handle the error.
+interpreter (typically the main interpreter) to handle the error.
.SH "LIMIT CHECKING API"
.PP
To check the resource limits for an interpreter, call
diff --git a/doc/Tcl.n b/doc/Tcl.n
index 0eb51b9..48a3488 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -223,7 +223,10 @@ before this range overflows, or when the maximum of eight digits
is reached. The upper bits of the Unicode character will be 0.
.RS
.PP
-The range U+010000\(enU+10FFFD is reserved for the future.
+The range U+00D800\(enU+00DFFF is reserved for surrogates, which
+are illegal on its own. Therefore, such sequences will result in
+the replacement character U+FFFD. Surrogate pairs should be
+encoded as single \e\fBU\fIhhhhhhhh\fR character.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index dc4f45f..62ceeab 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -79,7 +79,7 @@ against the standard Tcl library. Extensions (stub-enabled or
not) are not intended to call \fBTcl_Main\fR.
.PP
\fBTcl_Main\fR is not thread-safe. It should only be called by
-a single master thread of a multi-threaded application. This
+a single main thread of a multi-threaded application. This
restriction is not a problem with normal use described above.
.PP
\fBTcl_Main\fR and therefore all applications based upon it, like
@@ -112,7 +112,7 @@ The file name and encoding values managed by the routines
\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
are stored per-thread. Although the storage and retrieval
functions of these routines work in any thread, only those
-calls in the same master thread as \fBTcl_Main\fR can have
+calls in the same main thread as \fBTcl_Main\fR can have
any influence on it.
.PP
The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR
@@ -126,7 +126,7 @@ a \fIstartup script\fR, and \fIname\fR is taken to be the name
of the encoding of the contents of that file. \fBTcl_Main\fR
then calls \fBTcl_SetStartupScript\fR with these values.
.PP
-\fBTcl_Main\fR then defines in its master interpreter
+\fBTcl_Main\fR then defines in its main interpreter
the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
.PP
@@ -154,9 +154,9 @@ When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls
been requested, if any. If a startup script has been provided,
\fBTcl_Main\fR attempts to evaluate it. Otherwise, interactive
mode begins with examination of the variable \fItcl_rcFileName\fR
-in the master interpreter. If that variable exists and holds the
+in the main interpreter. If that variable exists and holds the
name of a readable file, the contents of that file are evaluated
-in the master interpreter. Then interactive operations begin,
+in the main interpreter. Then interactive operations begin,
with prompts and command evaluation results written to the standard
output channel, and commands read from the standard input channel
and then evaluated. The prompts written to the standard output
@@ -164,7 +164,7 @@ channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
The prompts and command evaluation results are written to the standard
output channel only if the Tcl variable \fItcl_interactive\fR in the
-master interpreter holds a non-zero integer value.
+main interpreter holds a non-zero integer value.
.PP
\fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
This allows, for example, Tk to be dynamically loaded and set its event
diff --git a/doc/Utf.3 b/doc/Utf.3
index c8c6132..263d4dd 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -285,13 +285,17 @@ byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte
Pascal Ord() function. It returns the Unicode character represented at the
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR. The source string must contain at least \fIindex\fR
-characters. Behavior is undefined if a negative \fIindex\fR is given.
+characters. If a negative \fIindex\fR is given or \fIindex\fR points
+to the second half of a surrogate pair, it returns -1.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must
contain at least \fIindex\fR characters. This is equivalent to calling
-\fBTcl_UtfNext\fR \fIindex\fR times. If a negative \fIindex\fR is given,
-the return pointer points to the first character in the source string.
+\fBTcl_UtfToUniChar\fR \fIindex\fR times, except if that would return
+a pointer to the second byte of a valid 4-byte UTF-8 sequence, in which
+case, \fBTcl_UtfToUniChar\fR will be called once more to find the end
+of the sequence. If a negative \fIindex\fR is given, the returned pointer
+points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands. It parses a backslash sequence and stores the properly formed
diff --git a/doc/clock.n b/doc/clock.n
index a85f29f..a3f934a 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -471,36 +471,36 @@ The following format groups are recognized by the \fBclock scan\fR and
\fBclock format\fR commands.
.TP
\fB%a\fR
-On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
+On output, produces an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
of the week in the given locale. On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%A\fR
-On output, receives the full name (\fIe.g.,\fR \fBMonday\fR) of the day
+On output, produces the full name (\fIe.g.,\fR \fBMonday\fR) of the day
of the week in the given locale. On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%b\fR
-On output, receives an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
+On output, produces an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
of the month in the given locale. On input, matches the name of the month
in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%B\fR
-On output, receives the full name (\fIe.g.,\fR \fBJanuary\fR)
+On output, produces the full name (\fIe.g.,\fR \fBJanuary\fR)
of the month in the given locale. On input, matches the name of the month
in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%c\fR
-On output, receives a localized representation of date and time of day;
+On output, produces a localized representation of date and time of day;
the localized representation is expected to use the Gregorian calendar.
On input, matches whatever \fB%c\fR produces.
.TP
\fB%C\fR
-On output, receives the number of the century in Indo-Arabic numerals.
+On output, produces the number of the century in Indo-Arabic numerals.
On input, matches one or two digits, possibly with leading whitespace,
that are expected to be the number of the century.
.TP
@@ -913,13 +913,14 @@ an error may result if these years are used.
\fIISO 8601 point-in-time\fR
.
An ISO 8601 point-in-time specification, such as
-.QW \fICCyymmdd\fBT\fIhhmmss\fR,
+.QW "\fICCyymmdd\fBT\fIhhmmss\fR",
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
+.QW "\fICCyymmdd\fBT\fIhh:mm:ss\fR" ,
or
-.QW \fICCyymmdd\fBT\fIhh\fB:\fImm\fB:\fIss\fR .
-Note that only these three formats are accepted.
+.QW "\fICCyy-mm-dd\fBT\fIhh\fB:\fImm\fB:\fIss\fR".
+Note that only these four formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601. Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
diff --git a/doc/dict.n b/doc/dict.n
index ff56b22..e06947b 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -28,7 +28,7 @@ writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string. The
updated dictionary value is returned.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the appending operation.
.VE TIP508
@@ -142,7 +142,7 @@ are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer. The updated
dictionary value is returned.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the incrementing operation.
.VE TIP508
@@ -172,7 +172,7 @@ there to be no items to append to the list. It is an error for the
value that the key maps to to not be representable as a list. The
updated dictionary value is returned.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the list-appending operation.
.VE TIP508
@@ -234,7 +234,7 @@ containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
of nested dictionaries. The updated dictionary value is returned.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value insert/update operation.
.VE TIP508
@@ -254,7 +254,7 @@ must be specified, but the last key on the key-path need not exist.
All other components on the path must exist. The updated dictionary
value is returned.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value remove operation.
.VE TIP508
@@ -274,7 +274,7 @@ or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
evaluation of \fIbody\fR.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the update operation.
.VE TIP508
@@ -313,7 +313,7 @@ dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
\fIbody\fR.
.VS TIP508
-If \fIdictionaryVarable\fR indicates an element that does not exist of an
+If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the updating operation.
.VE TIP508
diff --git a/doc/expr.n b/doc/expr.n
index 04f0cef..1498ba1 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -17,7 +17,7 @@ expr \- Evaluate an expression
.BE
.SH DESCRIPTION
.PP
-Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
+The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions. For those operators
@@ -46,22 +46,6 @@ value is the form produced by the \fB%g\fR format specifier of Tcl's
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
-An integer operand may be specified in decimal (the normal case, the optional
-first two characters are \fB0d\fR), binary
-(the first two characters are \fB0b\fR), octal
-(the first two characters are \fB0o\fR), or hexadecimal
-(the first two characters are \fB0x\fR) form. For
-compatibility with older Tcl releases, an operand that begins with \fB0\fR is
-interpreted as an octal integer even if the second character is not \fBo\fR.
-A floating-point number may be specified in any of several
-common decimal formats, and may use the decimal point \fB.\fR,
-\fBe\fR or \fBE\fR for scientific notation, and
-the sign characters \fB+\fR and \fB\-\fR. The
-following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
-The strings \fBInf\fR
-and \fBNaN\fR, in any combination of case, are also recognized as floating point
-values. An operand that doesn't have a numeric interpretation must be quoted
-with either braces or with double quotes.
.PP
An operand may be specified in any of the following ways:
.IP [1]
@@ -103,6 +87,49 @@ produces the value on the right side.
\fBexpr\fR 4*[llength "6 2"] \fI8\fR
\fBexpr\fR {{word one} < "word $a"} \fI0\fR
.CE
+.PP
+\fBInteger value\fR
+.PP
+An integer operand may be specified in decimal (the normal case, the optional
+first two characters are \fB0d\fR), binary
+(the first two characters are \fB0b\fR), octal
+(the first two characters are \fB0o\fR), or hexadecimal
+(the first two characters are \fB0x\fR) form. For
+compatibility with older Tcl releases, an operand that begins with \fB0\fR is
+interpreted as an octal integer even if the second character is not \fBo\fR.
+.PP
+\fBFloating-point value\fR
+.PP
+A floating-point number may be specified in any of several
+common decimal formats, and may use the decimal point \fB.\fR,
+\fBe\fR or \fBE\fR for scientific notation, and
+the sign characters \fB+\fR and \fB\-\fR. The
+following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
+The strings \fBInf\fR
+and \fBNaN\fR, in any combination of case, are also recognized as floating point
+values. An operand that doesn't have a numeric interpretation must be quoted
+with either braces or with double quotes.
+.PP
+\fBBoolean value\fR
+.PP
+A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR,
+or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR.
+.PP
+\fBDigit Separator\fR
+.PP
+Digits in any numeric value may be separated with one or more underscore
+characters, "\fB_\fR", to improve readability. These separators may only
+appear between digits. The separator may not appear at the start of a
+numeric value, between the leading 0 and radix specifier, or at the
+end of a numeric value. Here are some examples:
+.PP
+.CS
+.ta 9c
+\fBexpr\fR 100_000_000 \fI100000000\fR
+\fBexpr\fR 0xffff_ffff \fI4294967295\fR
+\fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR
+.CE
+.PP
.SS OPERATORS
.PP
For operators having both a numeric mode and a string mode, the numeric mode is
@@ -474,7 +501,7 @@ set randNum [\fBexpr\fR { int(100 * rand()) }]
array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n),
string(n), Tcl(n), while(n)
.SH KEYWORDS
-arithmetic, boolean, compare, expression, fuzzy comparison
+arithmetic, boolean, compare, expression, fuzzy comparison, integer value
.SH COPYRIGHT
.nf
Copyright \(co 1993 The Regents of the University of California.
diff --git a/doc/http.n b/doc/http.n
index 7845e60..03cc811 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -13,7 +13,7 @@
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
-\fBpackage require http\fI ?\fB2.8\fR?
+\fBpackage require http\fI ?\fB2.9\fR?
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config\fR ?\fI\-option value\fR ...?
@@ -170,7 +170,7 @@ throwing an error processing non-latin-1 characters.
The value of the User-Agent header in the HTTP request. In an unsafe
interpreter, the default value depends upon the operating system, and
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
-.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
+.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.9.0 Tcl/8.6.9\fR" .
A safe interpreter cannot determine its operating system, and so the default
in a safe interpreter is to use a Windows 10 value with the current version
numbers of \fBhttp\fR and \fBTcl\fR.
@@ -259,6 +259,10 @@ proc httpHandlerCallback {socket token} {
return $nbytes
}
.CE
+.PP
+The \fBhttp::geturl\fR code for the \fB-handler\fR option is not compatible with either compression or chunked transfer-encoding. If \fB-handler\fR is specified, then to work around these issues \fBhttp::geturl\fR will reduce the HTTP protocol to 1.0, and override the \fB-zip\fR option (i.e. it will not send the header "\fBAccept-Encoding: gzip,deflate,compress\fR").
+.PP
+If options \fB-handler\fR and \fB-channel\fR are used together, the handler is responsible for copying the data from the HTTP socket to the specified channel. The name of the channel is available to the handler as element \fB-channel\fR of the token array.
.RE
.TP
\fB\-headers\fR \fIkeyvaluelist\fR
diff --git a/doc/info.n b/doc/info.n
index dc21ac1..a23cf3a 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -64,7 +64,7 @@ instance of \fBoo::object\fR or one of its subclasses.
that represents an instance of \fBoo::object\fR or one of its subclasses.
.IP \fBproc\fR
\fIcommandName\fR was created by \fBproc\fR.
-.IP \fBslave\fR
+.IP \fBinterp\fR
\fIcommandName\fR was created by \fBinterp create\fR.
.IP \fBzlibStream\fR
\fIcommandName\fR was created by \fBzlib stream\fR.
@@ -278,7 +278,7 @@ Returns the name of each file loaded in \fIinterp\fR va \fBload\fR as part of
\fIpackage\fR . If \fIpackage\fR is not given, returns a list where each item
is the name of the loaded file and the name of the package for which the file
was loaded. For a statically-loaded package the name of the file is the empty
-string. For \fInterp\fR, the empty string is the current interpreter.
+string. For \fIinterp\fR, the empty string is the current interpreter.
.TP
\fBinfo locals \fR?\fIpattern\fR?
.
diff --git a/doc/interp.n b/doc/interp.n
index 54555e3..35f26d5 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -19,18 +19,18 @@ interp \- Create and manipulate Tcl interpreters
.PP
This command makes it possible to create one or more new Tcl
interpreters that co-exist with the creating interpreter in the
-same application. The creating interpreter is called the \fImaster\fR
-and the new interpreter is called a \fIslave\fR.
-A master can create any number of slaves, and each slave can
-itself create additional slaves for which it is master, resulting
+same application. The creating interpreter is called the \fIparent\fR
+and the new interpreter is called a \fIchild\fR.
+A parent can create any number of children, and each child can
+itself create additional children for which it is parent, resulting
in a hierarchy of interpreters.
.PP
Each interpreter is independent from the others: it has its own name
space for commands, procedures, and global variables.
-A master interpreter may create connections between its slaves and
+A parent interpreter may create connections between its children and
itself using a mechanism called an \fIalias\fR. An \fIalias\fR is
-a command in a slave interpreter which, when invoked, causes a
-command to be invoked in its master interpreter or in another slave
+a command in a child interpreter which, when invoked, causes a
+command to be invoked in its parent interpreter or in another child
interpreter. The only other connections between interpreters are
through environment variables (the \fBenv\fR variable), which are
normally shared among all interpreters in the application,
@@ -41,7 +41,7 @@ share files and to transfer references to open files from one interpreter
to another.
.PP
The \fBinterp\fR command also provides support for \fIsafe\fR
-interpreters. A safe interpreter is a slave whose functions have
+interpreters. A safe interpreter is a child whose functions have
been greatly restricted, so that it is safe to execute untrusted
scripts without fear of them damaging other interpreters or the
application's environment. For example, all IO channel creation
@@ -54,18 +54,18 @@ instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
-kernel call) between a slave interpreter and its master.
+kernel call) between a child interpreter and its parent.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl lists containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
-interpreter in its immediate master. Interpreter names are relative to the
+interpreter in its immediate parent. Interpreter names are relative to the
interpreter in which they are used. For example, if
.QW \fBa\fR
-is a slave of the current interpreter and it has a slave
+is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
-which in turn has a slave
+which in turn has a child
.QW \fBa11\fR ,
the qualified name of
.QW \fBa11\fR
@@ -77,14 +77,14 @@ is the list
The \fBinterp\fR command, described below, accepts qualified interpreter
names as arguments; the interpreter in which the command is being evaluated
can always be referred to as \fB{}\fR (the empty list or string). Note that
-it is impossible to refer to a master (ancestor) interpreter by name in a
-slave interpreter except through aliases. Also, there is no global name by
+it is impossible to refer to a parent (ancestor) interpreter by name in a
+child interpreter except through aliases. Also, there is no global name by
which one can refer to the first interpreter created in an application.
Both restrictions are motivated by safety concerns.
.SH "THE INTERP COMMAND"
.PP
The \fBinterp\fR command is used to create, delete, and manipulate
-slave interpreters, and to share or transfer
+child interpreters, and to share or transfer
channels between interpreters. It can have any of several forms, depending
on the \fIsubcommand\fR argument:
.TP
@@ -94,11 +94,11 @@ Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the name of the source command in the
-slave is different from \fIsrcToken\fR).
+child is different from \fIsrcToken\fR).
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR
.
-Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by
+Deletes the alias for \fIsrcToken\fR in the child interpreter identified by
\fIsrcPath\fR.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
@@ -106,9 +106,9 @@ command will be deleted.
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
.
-This command creates an alias between one slave and another (see the
-\fBalias\fR slave command below for creating aliases between a slave
-and its master). In this command, either of the slave interpreters
+This command creates an alias between one child and another (see the
+\fBalias\fR child command below for creating aliases between a child
+and its parent). In this command, either of the child interpreters
may be anywhere in the hierarchy of interpreters under the interpreter
invoking the command.
\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
@@ -117,9 +117,9 @@ interpreter. For example,
.QW "\fBa b\fR"
identifies an interpreter
.QW \fBb\fR ,
-which is a slave of interpreter
+which is a child of interpreter
.QW \fBa\fR ,
-which is a slave of the invoking interpreter. An empty list specifies
+which is a child of the invoking interpreter. An empty list specifies
the interpreter invoking the command. \fIsrcCmd\fR gives the name of
a new command, which will be created in the source interpreter.
\fITargetPath\fR and \fItargetCmd\fR specify a target interpreter
@@ -169,33 +169,33 @@ used.
.TP
\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
.
-Creates a slave interpreter identified by \fIpath\fR and a new command,
-called a \fIslave command\fR. The name of the slave command is the last
-component of \fIpath\fR. The new slave interpreter and the slave command
+Creates a child interpreter identified by \fIpath\fR and a new command,
+called a \fIchild command\fR. The name of the child command is the last
+component of \fIpath\fR. The new child interpreter and the child command
are created in the interpreter identified by the path obtained by removing
the last component from \fIpath\fR. For example, if \fIpath\fR is \fBa b
-c\fR then a new slave interpreter and slave command named \fBc\fR are
+c\fR then a new child interpreter and child command named \fBc\fR are
created in the interpreter identified by the path \fBa b\fR.
-The slave command may be used to manipulate the new interpreter as
+The child command may be used to manipulate the new interpreter as
described below. If \fIpath\fR is omitted, Tcl creates a unique name of the
form \fBinterp\fIx\fR, where \fIx\fR is an integer, and uses it for the
-interpreter and the slave command. If the \fB\-safe\fR switch is specified
-(or if the master interpreter is a safe interpreter), the new slave
+interpreter and the child command. If the \fB\-safe\fR switch is specified
+(or if the parent interpreter is a safe interpreter), the new child
interpreter will be created as a safe interpreter with limited
-functionality; otherwise the slave will include the full set of Tcl
+functionality; otherwise the child will include the full set of Tcl
built-in commands and variables. The \fB\-\|\-\fR switch can be used to
mark the end of switches; it may be needed if \fIpath\fR is an unusual
value such as \fB\-safe\fR. The result of the command is the name of the
-new interpreter. The name of a slave interpreter must be unique among all
-the slaves for its master; an error occurs if a slave interpreter by the
-given name already exists in this master.
-The initial recursion limit of the slave interpreter is set to the
+new interpreter. The name of a child interpreter must be unique among all
+the children for its parent; an error occurs if a child interpreter by the
+given name already exists in this parent.
+The initial recursion limit of the child interpreter is set to the
current recursion limit of its parent interpreter.
.TP
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
-slave interpreter identified by \fIpath\fR. If no arguments are
+child interpreter identified by \fIpath\fR. If no arguments are
given, option and current setting are returned. If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
@@ -237,8 +237,8 @@ consistency of the underlying interpreter's state.
\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
.
Deletes zero or more interpreters given by the optional \fIpath\fR
-arguments, and for each interpreter, it also deletes its slaves. The
-command also deletes the slave command for each interpreter deleted.
+arguments, and for each interpreter, it also deletes its children. The
+command also deletes the child command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP
@@ -246,20 +246,20 @@ exists, the command raises an error.
.
This command concatenates all of the \fIarg\fR arguments in the same
fashion as the \fBconcat\fR command, then evaluates the resulting string as
-a Tcl script in the slave interpreter identified by \fIpath\fR. The result
+a Tcl script in the child interpreter identified by \fIpath\fR. The result
of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame of the
-\fIpath\fR interpreter; this is so that the implementations (in a master
-interpreter) of aliases in a slave interpreter can execute scripts in
-the slave that find out information about the slave's current state
+\fIpath\fR interpreter; this is so that the implementations (in a parent
+interpreter) of aliases in a child interpreter can execute scripts in
+the child that find out information about the child's current state
and stack frame.
.TP
\fBinterp exists \fIpath\fR
.
-Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
-exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
+Returns \fB1\fR if a child interpreter by the specified \fIpath\fR
+exists in this parent, \fB0\fR otherwise. If \fIpath\fR is omitted, the
invoking interpreter is used.
.TP
\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
@@ -285,7 +285,7 @@ Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
-prevents slaves from fooling a master interpreter into hiding the wrong
+prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
@@ -369,12 +369,16 @@ Both interpreters must close it to close the underlying IO channel; IO
channels accessible in an interpreter are automatically closed when an
interpreter is destroyed.
.TP
-\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
+\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
.
-Returns a Tcl list of the names of all the slave interpreters associated
+Returns a Tcl list of the names of all the child interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.TP
+\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
+.
+Synonym for . \fBinterp\fR \fBchildren\fR ?\fIpath\fR?
+.TP
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
.
Returns a Tcl list describing the target interpreter for an alias. The
@@ -391,48 +395,48 @@ The target command does not have to be defined at the time of this invocation.
Causes the IO channel identified by \fIchannelId\fR to become available in
the interpreter identified by \fIdestPath\fR and unavailable in the
interpreter identified by \fIsrcPath\fR.
-.SH "SLAVE COMMAND"
+.SH "CHILD COMMAND"
.PP
-For each slave interpreter created with the \fBinterp\fR command, a
-new Tcl command is created in the master interpreter with the same
+For each child interpreter created with the \fBinterp\fR command, a
+new Tcl command is created in the parent interpreter with the same
name as the new interpreter. This command may be used to invoke
various operations on the interpreter. It has the following
general form:
.PP
.CS
-\fIslave command \fR?\fIarg arg ...\fR?
+\fIchild command \fR?\fIarg arg ...\fR?
.CE
.PP
-\fISlave\fR is the name of the interpreter, and \fIcommand\fR
+\fIChild\fR is the name of the interpreter, and \fIcommand\fR
and the \fIarg\fRs determine the exact behavior of the command.
The valid forms of this command are:
.TP
-\fIslave \fBaliases\fR
+\fIchild \fBaliases\fR
.
Returns a Tcl list whose elements are the tokens of all the
-aliases in \fIslave\fR. The tokens correspond to the values returned when
+aliases in \fIchild\fR. The tokens correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
-\fIslave \fBalias \fIsrcToken\fR
+\fIchild \fBalias \fIsrcToken\fR
.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the actual source command in the
-slave is different from \fIsrcToken\fR).
+child is different from \fIsrcToken\fR).
.TP
-\fIslave \fBalias \fIsrcToken \fB{}\fR
+\fIchild \fBalias \fIsrcToken \fB{}\fR
.
-Deletes the alias for \fIsrcToken\fR in the slave interpreter.
+Deletes the alias for \fIsrcToken\fR in the child interpreter.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
command will be deleted.
.TP
-\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
+\fIchild \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
.
Creates an alias such that whenever \fIsrcCmd\fR is invoked
-in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
+in \fIchild\fR, \fItargetCmd\fR is invoked in the parent.
The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
arguments, prepended before any arguments passed in the invocation of
\fIsrcCmd\fR.
@@ -441,69 +445,69 @@ The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
-\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
+\fIchild \fBbgerror\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
-for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
+for the \fIchild\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
-\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
+\fIchild \fBeval \fIarg \fR?\fIarg ..\fR?
.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
-the resulting string as a Tcl script in \fIslave\fR.
+the resulting string as a Tcl script in \fIchild\fR.
The result of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame
-of \fIslave\fR; this is so that the implementations (in a master
-interpreter) of aliases in a slave interpreter can execute scripts in
-the slave that find out information about the slave's current state
+of \fIchild\fR; this is so that the implementations (in a parent
+interpreter) of aliases in a child interpreter can execute scripts in
+the child that find out information about the child's current state
and stack frame.
.TP
-\fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
+\fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
.
This command exposes the hidden command \fIhiddenName\fR, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
-in \fIslave\fR.
+in \fIchild\fR.
If an exposed command with the targeted name already exists, this command
fails.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
-\fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
+\fIchild \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
.
This command hides the exposed command \fIexposedCmdName\fR, renaming it to
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
-argument is not given, in the \fIslave\fR interpreter.
+argument is not given, in the \fIchild\fR interpreter.
If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden are looked up in the global
namespace even if the current namespace is not the global one. This
-prevents slaves from fooling a master interpreter into hiding the wrong
+prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
-\fIslave \fBhidden\fR
+\fIchild \fBhidden\fR
.
-Returns a list of the names of all hidden commands in \fIslave\fR.
+Returns a list of the names of all hidden commands in \fIchild\fR.
.TP
-\fIslave \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
+\fIchild \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
.
This command invokes the hidden command \fIhiddenName\fR with the
-supplied arguments, in \fIslave\fR. No substitutions or evaluations are
+supplied arguments, in \fIchild\fR. No substitutions or evaluations are
applied to the arguments. Three \fI\-option\fRs are supported, all
of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
If the \fB\-namespace\fR flag is given, the hidden command is invoked in
-the specified namespace in the slave.
+the specified namespace in the child.
If the \fB\-global\fR flag is given, the command is invoked at the global
-level in the slave; otherwise it is invoked at the current call frame and
+level in the child; otherwise it is invoked at the current call frame and
can access local variables in that or outer call frames.
The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
.QW \-
@@ -511,37 +515,37 @@ character, and is otherwise unnecessary.
If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the
\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
-current context stack frame of \fIslave\fR.
+current context stack frame of \fIchild\fR.
For more details on hidden commands,
see \fBHIDDEN COMMANDS\fR, below.
.TP
-\fIslave \fBissafe\fR
+\fIchild \fBissafe\fR
.
-Returns \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
+Returns \fB1\fR if the child interpreter is safe, \fB0\fR otherwise.
.TP
-\fIslave \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
+\fIchild \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
.
Sets up, manipulates and queries the configuration of the resource
-limit \fIlimitType\fR for the slave interpreter. If no \fI\-option\fR
+limit \fIlimitType\fR for the child interpreter. If no \fI\-option\fR
is specified, return the current configuration of the limit. If
\fI\-option\fR is the sole argument, return the value of that option.
Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must
supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of
what limits and options are supported.
.TP
-\fIslave \fBmarktrusted\fR
+\fIchild \fBmarktrusted\fR
.
-Marks the slave interpreter as trusted. Can only be invoked by a
+Marks the child interpreter as trusted. Can only be invoked by a
trusted interpreter. This command does not expose any hidden
-commands in the slave interpreter. The command has no effect if the slave
+commands in the child interpreter. The command has no effect if the child
is already trusted.
.TP
-\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
+\fIchild\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
.
-Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
-If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
+Returns the maximum allowable nesting depth for the \fIchild\fR interpreter.
+If \fInewlimit\fR is specified, the recursion limit in \fIchild\fR will be
set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
-and related procedures in \fIslave\fR will return an error.
+and related procedures in \fIchild\fR will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
maximum value of a non-long integer on the platform.
@@ -565,14 +569,14 @@ For example, commands to create files on disk are removed, and the
\fBexec\fR command is removed, since it could be used to cause damage
through subprocesses.
Limited access to these facilities can be provided, by creating
-aliases to the master interpreter which check their arguments carefully
+aliases to the parent interpreter which check their arguments carefully
and provide restricted access to a safe subset of facilities.
For example, file creation might be allowed in a particular subdirectory
and subprocess invocation might be allowed for a carefully selected and
fixed set of programs.
.PP
A safe interpreter is created by specifying the \fB\-safe\fR switch
-to the \fBinterp create\fR command. Furthermore, any slave created
+to the \fBinterp create\fR command. Furthermore, any child created
by a safe interpreter will also be safe.
.PP
A safe interpreter is created with exactly the following set of
@@ -659,15 +663,15 @@ 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 slave and the target of the alias is a trusted
-master. The most important thing in guaranteeing safety is to
-ensure that information passed from the slave to the master is
-never evaluated or substituted in the master; if this were to
-occur, it would enable an evil script in the slave to invoke
-arbitrary functions in the master, which would compromise security.
-.PP
-When the source for an alias is invoked in the slave interpreter, the
+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
+arbitrary functions in the parent, which would compromise security.
+.PP
+When the source for an alias is invoked in the child interpreter, the
usual Tcl substitutions are performed when parsing that command.
These substitutions are carried out in the source interpreter just
as they would be for any other command invoked in that interpreter.
@@ -694,8 +698,8 @@ the alias's source command is parsed in the source interpreter.
When writing the \fItargetCmd\fRs for aliases in safe interpreters,
it is very important that the arguments to that command never be
evaluated or substituted, since this would provide an escape
-mechanism whereby the slave interpreter could execute arbitrary
-code in the master. This in turn would compromise the security
+mechanism whereby the child interpreter could execute arbitrary
+code in the parent. This in turn would compromise the security
of the system.
.SH "HIDDEN COMMANDS"
.PP
@@ -722,28 +726,28 @@ invoke\fR. Hidden commands and exposed commands reside in separate name
spaces. It is possible to define a hidden command and an exposed command by
the same name within one interpreter.
.PP
-Hidden commands in a slave interpreter can be invoked in the body of
-procedures called in the master during alias invocation. For example, an
-alias for \fBsource\fR could be created in a slave interpreter. When it is
-invoked in the slave interpreter, a procedure is called in the master
+Hidden commands in a child interpreter can be invoked in the body of
+procedures called in the parent during alias invocation. For example, an
+alias for \fBsource\fR could be created in a child interpreter. When it is
+invoked in the child interpreter, a procedure is called in the parent
interpreter to check that the operation is allowable (e.g. it asks to
-source a file that the slave interpreter is allowed to access). The
-procedure then it invokes the hidden \fBsource\fR command in the slave
+source a file that the child interpreter is allowed to access). The
+procedure then it invokes the hidden \fBsource\fR command in the child
interpreter to actually source in the contents of the file. Note that two
-commands named \fBsource\fR exist in the slave interpreter: the alias, and
+commands named \fBsource\fR exist in the child interpreter: the alias, and
the hidden command.
.PP
-Because a master interpreter may invoke a hidden command as part of
+Because a parent interpreter may invoke a hidden command as part of
handling an alias invocation, great care must be taken to avoid evaluating
any arguments passed in through the alias invocation.
-Otherwise, malicious slave interpreters could cause a trusted master
+Otherwise, malicious child interpreters could cause a trusted parent
interpreter to execute dangerous commands on their behalf. See the section
on \fBALIAS INVOCATION\fR for a more complete discussion of this topic.
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 slaves 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
@@ -762,12 +766,12 @@ qualifiers, and you must first rename a command in a namespace to the
global namespace before you can hide it.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
-prevents slaves from fooling a master interpreter into hiding the wrong
+prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
.SH "RESOURCE LIMITS"
.PP
Every interpreter has two kinds of resource limits that may be imposed by any
-master interpreter upon its slaves. Command limits (of type \fBcommand\fR)
+parent interpreter upon its children. Command limits (of type \fBcommand\fR)
restrict the total number of Tcl commands that may be executed by an
interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and
time limits (of type \fBtime\fR) place a limit by which execution within the
@@ -776,7 +780,7 @@ interpreter must complete. Note that time limits are expressed as
\fBafter\fR) because they may be modified after creation.
.PP
When a limit is exceeded for an interpreter, first any handler callbacks
-defined by master interpreters are called. If those callbacks increase or
+defined by parent interpreters are called. If those callbacks increase or
remove the limit, execution within the (previously) limited interpreter
continues. If the limit is still in force, an error is generated at that point
and normal processing of errors within the interpreter (by the \fBcatch\fR
@@ -833,13 +837,13 @@ This option specifies the number of commands that the interpreter may execute
before triggering the command limit. This option may be the empty string,
which indicates that a command limit is not set for the interpreter.
.PP
-Where an interpreter with a resource limit set on it creates a slave
-interpreter, that slave interpreter will have resource limits imposed on it
-that are at least as restrictive as the limits on the creating master
-interpreter. If the master interpreter of the limited master wishes to relax
+Where an interpreter with a resource limit set on it creates a child
+interpreter, that child interpreter will have resource limits imposed on it
+that are at least as restrictive as the limits on the creating parent
+interpreter. If the parent interpreter of the limited parent wishes to relax
these conditions, it should hide the \fBinterp\fR command in the child and
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
-access as it chooses to the \fBinterp\fR command to the limited master as
+access as it chooses to the \fBinterp\fR command to the limited parent as
necessary.
.SH "BACKGROUND EXCEPTION HANDLING"
.PP
@@ -900,9 +904,9 @@ set i [\fBinterp create\fR]
}
.CE
.SH "SEE ALSO"
-bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3), Tcl_BackgroundException(3)
+bgerror(n), load(n), safe(n), Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3)
.SH KEYWORDS
-alias, master interpreter, safe interpreter, slave interpreter
+alias, parent interpreter, safe interpreter, child interpreter
'\"Local Variables:
'\"mode: nroff
'\"End:
diff --git a/doc/library.n b/doc/library.n
index 6f8f265..8aa8af7 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -124,7 +124,7 @@ will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
generate a new index file \fBfoo/tclIndex\fR.
.PP
\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them into a
-slave interpreter and monitoring the proc and namespace commands that
+child interpreter and monitoring the proc and namespace commands that
are executed. Extensions can use the (undocumented)
auto_mkindex_parser package to register other commands that can
contribute to the auto_load index. You will have to read through
@@ -299,18 +299,13 @@ These variables are only used in the \fBtcl_endOfWord\fR,
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not. If the pattern matches a character, the character is
-considered to be a non-word character. On Windows platforms, spaces,
-tabs, and newlines are considered non-word characters. Under Unix,
-everything but numbers, letters and underscores are considered
-non-word characters.
+considered to be a non-word character. The default is "\\W".
.TP
\fBtcl_wordchars\fR
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not. If the pattern matches a character, the character is
-considered to be a word character. On Windows platforms, words are
-comprised of any character that is not a space, tab, or newline. Under
-Unix, words are comprised of numbers, letters or underscores.
+considered to be a word character. The default is "\\w".
.SH "SEE ALSO"
env(n), info(n), re_syntax(n)
.SH KEYWORDS
diff --git a/doc/lsearch.n b/doc/lsearch.n
index 2586486..c5dc98f 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -22,7 +22,8 @@ This command searches the elements of \fIlist\fR to see if one
of them matches \fIpattern\fR. If so, the command returns the index
of the first matching element
(unless the options \fB\-all\fR or \fB\-inline\fR are specified.)
-If not, the command returns \fB\-1\fR. The \fIoption\fR arguments
+If not, the command returns \fB\-1\fR or (if options \fB\-all\fR
+or \fB\-inline\fR are specified) the empty string. The \fIoption\fR arguments
indicates how the elements of the list are to be matched against
\fIpattern\fR and must have one of the values below:
.SS "MATCHING STYLE OPTIONS"
diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n
index ec39be9..5a6b905 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -42,7 +42,7 @@ The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
-It does this by loading each file into a slave
+It does this by loading each file into a child
interpreter and seeing what packages
and new commands appear (this is why it is essential to have
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
@@ -109,7 +109,7 @@ the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
-current interpreter and match \fIpkgPat\fR into the slave interpreter used to
+current interpreter and match \fIpkgPat\fR into the child interpreter used to
generate the index. The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
diff --git a/doc/safe.n b/doc/safe.n
index b39f2c2..819287d 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -11,17 +11,17 @@
.SH NAME
safe \- Creating and manipulating safe interpreters
.SH SYNOPSIS
-\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
+\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
.sp
-\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
+\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
.sp
-\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
+\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
.sp
-\fB::safe::interpDelete\fR \fIslave\fR
+\fB::safe::interpDelete\fR \fIchild\fR
.sp
-\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
+\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
.sp
-\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
+\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
.sp
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
.SS OPTIONS
@@ -44,7 +44,7 @@ application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
hosting application to any party.
.PP
-Safe Tcl allows a master interpreter to create safe, restricted
+Safe Tcl allows a parent interpreter to create safe, restricted
interpreters that contain a set of predefined aliases for the \fBsource\fR,
\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
are able to use the auto-loading and package mechanisms.
@@ -53,39 +53,47 @@ No knowledge of the file system structure is leaked to the
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
-master interpreter transparently
+parent interpreter transparently
translates the token into a real directory name and executes the
requested operation (see the section \fBSECURITY\fR below for details).
Different levels of security can be selected by using the optional flags
of the commands described below.
.PP
-All commands provided in the master interpreter by Safe Tcl reside in
+All commands provided in the parent interpreter by Safe Tcl reside in
the \fBsafe\fR namespace.
.SH COMMANDS
-The following commands are provided in the master interpreter:
+The following commands are provided in the parent interpreter:
.TP
-\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
+\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
Creates a safe interpreter, installs the aliases described in the section
\fBALIASES\fR and initializes the auto-loading and package mechanism as
specified by the supplied \fIoptions\fR.
See the \fBOPTIONS\fR section below for a description of the
optional arguments.
-If the \fIslave\fR argument is omitted, a name will be generated.
+If the \fIchild\fR argument is omitted, a name will be generated.
\fB::safe::interpCreate\fR always returns the interpreter name.
+.sp
+The interpreter name \fIchild\fR may include namespace separators,
+but may not have leading or trailing namespace separators, or excess
+colon characters in namespace separators. The interpreter name is
+qualified relative to the global namespace ::, not the namespace in which
+the \fB::safe::interpCreate\fR command is evaluated.
.TP
-\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
+\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
This command is similar to \fBinterpCreate\fR except it that does not
-create the safe interpreter. \fIslave\fR must have been created by some
-other means, like \fBinterp create\fR \fB\-safe\fR.
+create the safe interpreter. \fIchild\fR must have been created by some
+other means, like \fBinterp create\fR \fB\-safe\fR. The interpreter
+name \fIchild\fR may include namespace separators, subject to the same
+restrictions as for \fBinterpCreate\fR.
.TP
-\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
+\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
named safe interpreter as a list of options and their current values
-for that \fIslave\fR.
+for that \fIchild\fR.
If a single additional argument is provided,
it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
\fIname\fR is the full name of that option and \fIvalue\fR the current value
-for that option and the \fIslave\fR.
+for that option and the \fIchild\fR.
If more than two additional arguments are provided, it will reconfigure the
safe interpreter and change each and only the provided options.
See the section on \fBOPTIONS\fR below for options description.
@@ -105,14 +113,14 @@ safe::interpConfigure $i0 \-delete {foo bar} \-statics 0
.CE
.RE
.TP
-\fB::safe::interpDelete\fR \fIslave\fR
+\fB::safe::interpDelete\fR \fIchild\fR
Deletes the safe interpreter and cleans up the corresponding
-master interpreter data structures.
+parent interpreter data structures.
If a \fIdeleteHook\fR script was specified for this interpreter it is
evaluated before the interpreter is deleted, with the name of the
interpreter as an additional argument.
.TP
-\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
+\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
This command finds and returns the token for the real directory
\fIdirectory\fR in the safe interpreter's current virtual access path.
It generates an error if the directory is not found.
@@ -120,14 +128,14 @@ Example of use:
.RS
.PP
.CS
-$slave eval [list set tk_library \e
+$child eval [list set tk_library \e
[::safe::interpFindInAccessPath $name $tk_library]]
.CE
.RE
.TP
-\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
+\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
This command adds \fIdirectory\fR to the virtual path maintained for the
-safe interpreter in the master, and returns the token that can be used in
+safe interpreter in the parent, and returns the token that can be used in
the safe interpreter to obtain access to files in that directory.
If the directory is already in the virtual path, it only returns the token
without adding the directory to the virtual path again.
@@ -135,7 +143,7 @@ Example of use:
.RS
.PP
.CS
-$slave eval [list set tk_library \e
+$child eval [list set tk_library \e
[::safe::interpAddToAccessPath $name $tk_library]]
.CE
.RE
@@ -168,10 +176,10 @@ Note that the safe interpreter only received an error message saying that
the file was not found:
.PP
.CS
-NOTICE for slave interp10 : Created
-NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
-NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
-ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
+NOTICE for child interp10 : Created
+NOTICE for child interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
+NOTICE for child interp10 : auto_path in interp10 has been set to {$p(:0:)}
+ERROR for child interp10 : /foo/bar/init.tcl: no such file or directory
.CE
.RE
.SS OPTIONS
@@ -187,7 +195,7 @@ This option sets the list of directories from which the safe interpreter
can \fBsource\fR and \fBload\fR files.
If this option is not specified, or if it is given as the
empty list, the safe interpreter will use the same directories as its
-master for auto-loading.
+parent for auto-loading.
See the section \fBSECURITY\fR below for more detail about virtual paths,
tokens and access control.
.TP
@@ -216,7 +224,7 @@ to load packages into its own sub-interpreters.
.TP
\fB\-deleteHook\fR \fIscript\fR
When this option is given a non-empty \fIscript\fR, it will be
-evaluated in the master with the name of
+evaluated in the parent with the name of
the safe interpreter as an additional argument
just before actually deleting the safe interpreter.
Giving an empty value removes any currently installed deletion hook
@@ -281,8 +289,8 @@ potential for information leakage about its directory structure.
To prevent this, commands that take file names as arguments in a safe
interpreter use tokens instead of the real directory names.
These tokens are translated to the real directory name while a request to,
-e.g., source a file is mediated by the master interpreter.
-This virtual path system is maintained in the master interpreter for each safe
+e.g., source a file is mediated by the parent interpreter.
+This virtual path system is maintained in the parent interpreter for each safe
interpreter created by \fB::safe::interpCreate\fR or initialized by
\fB::safe::interpInit\fR and
the path maps tokens accessible in the safe interpreter into real path
@@ -291,7 +299,7 @@ from gaining knowledge about the
structure of the file system of the host on which the interpreter is
executing.
The only valid file names arguments
-for the \fBsource\fR and \fBload\fR aliases provided to the slave
+for the \fBsource\fR and \fBload\fR aliases provided to the child
are path in the form of
\fB[file join \fItoken filename\fB]\fR (i.e. when using the
native file path formats: \fItoken\fB/\fIfilename\fR
@@ -320,26 +328,26 @@ or be called
.PP
Each element of the initial access path
list will be assigned a token that will be set in
-the slave \fBauto_path\fR and the first element of that list will be set as
-the \fBtcl_library\fR for that slave.
+the child \fBauto_path\fR and the first element of that list will be set as
+the \fBtcl_library\fR for that child.
.PP
If the access path argument is not given or is the empty list,
-the default behavior is to let the slave access the same packages
-as the master has access to (Or to be more precise:
+the default behavior is to let the child access the same packages
+as the parent has access to (Or to be more precise:
only packages written in Tcl (which by definition cannot be dangerous
-as they run in the slave interpreter) and C extensions that
-provides a _SafeInit entry point). For that purpose, the master's
-\fBauto_path\fR will be used to construct the slave access path.
-In order that the slave successfully loads the Tcl library files
+as they run in the child interpreter) and C extensions that
+provides a _SafeInit entry point). For that purpose, the parent's
+\fBauto_path\fR will be used to construct the child access path.
+In order that the child successfully loads the Tcl library files
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
added or moved to the first position if necessary, in the
-slave access path, so the slave
-\fBtcl_library\fR will be the same as the master's (its real
-path will still be invisible to the slave though).
-In order that auto-loading works the same for the slave and
-the master in this by default case, the first-level
-sub directories of each directory in the master \fBauto_path\fR will
-also be added (if not already included) to the slave access path.
+child access path, so the child
+\fBtcl_library\fR will be the same as the parent's (its real
+path will still be invisible to the child though).
+In order that auto-loading works the same for the child and
+the parent in this by default case, the first-level
+sub directories of each directory in the parent \fBauto_path\fR will
+also be added (if not already included) to the child access path.
You can always specify a more
restrictive path for which sub directories will never be searched by
explicitly specifying your directory list with the \fB\-accessPath\fR flag
@@ -352,8 +360,8 @@ to synchronize its \fBauto_index\fR with the new token list.
.SH "SEE ALSO"
interp(n), library(n), load(n), package(n), source(n), unknown(n)
.SH KEYWORDS
-alias, auto\-loading, auto_mkindex, load, master interpreter, safe
-interpreter, slave interpreter, source
+alias, auto\-loading, auto_mkindex, load, parent interpreter, safe
+interpreter, child interpreter, source
'\" Local Variables:
'\" mode: nroff
'\" End:
diff --git a/doc/string.n b/doc/string.n
index 44d621d..7cd53ca 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -505,7 +505,7 @@ if {$length == 0} {
.SH "SEE ALSO"
expr(n), list(n)
.SH KEYWORDS
-case conversion, compare, index, match, pattern, string, word, equal,
+case conversion, compare, index, integer value, match, pattern, string, word, equal,
ctype, character, reverse
.\" Local Variables:
.\" mode: nroff
diff --git a/doc/tcltest.n b/doc/tcltest.n
index b161a2b..25e5e5e 100644
--- a/doc/tcltest.n
+++ b/doc/tcltest.n
@@ -203,7 +203,7 @@ array. Returns an empty string.
.TP
\fBrunAllTests\fR
.
-This is a master command meant to run an entire suite of tests,
+This is a main command meant to run an entire suite of tests,
spanning multiple files and/or directories, as governed by
the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR
below for a complete description of the many variations possible
@@ -804,17 +804,17 @@ then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
evaluate each file. The multi-process operation is useful
when testing can cause errors so severe that a process
terminates. Although such an error may terminate a child
-process evaluating one file, the master process can continue
+process evaluating one file, the main process can continue
with the rest of the test suite. In multi-process operation,
-the configuration of \fBtcltest\fR in the master process is
+the configuration of \fBtcltest\fR in the main process is
passed to the child processes as command line arguments,
with the exception of \fBconfigure \-outfile\fR. The
\fBrunAllTests\fR command in the
-master process collects all output from the child processes
-and collates their results into one master report. Any
+main process collects all output from the child processes
+and collates their results into one main report. Any
reports of individual test failures, or messages requested
by a \fBconfigure \-verbose\fR setting are passed directly
-on to \fBoutputChannel\fR by the master process.
+on to \fBoutputChannel\fR by the main process.
.PP
After evaluating all selected test files, a summary of the
results is printed to \fBoutputChannel\fR. The summary
@@ -1134,7 +1134,7 @@ A good namespace to use is a child namespace \fBtest\fR of the namespace
of the module you are testing.
.PP
A test file should also be able to be evaluated directly as a script,
-not depending on being called by a master \fBrunAllTests\fR. This
+not depending on being called by a main \fBrunAllTests\fR. This
means that each test file should process command line arguments to give
the tester all the configuration control that \fBtcltest\fR provides.
.PP
@@ -1145,7 +1145,7 @@ Here is a sketch of a sample test file illustrating those points:
.RS
.PP
.CS
-package require tcltest 2.2
+package require tcltest 2.5
eval \fB::tcltest::configure\fR $argv
package require example
namespace eval ::example::test {
@@ -1175,12 +1175,12 @@ doing any necessary setup. This script is usually named \fBall.tcl\fR
because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
-Here is a sketch of a sample test suite master script:
+Here is a sketch of a sample test suite main script:
.RS
.PP
.CS
-package require Tcl 8.4
-package require tcltest 2.2
+package require Tcl 8.6
+package require tcltest 2.5
package require example
\fB::tcltest::configure\fR -testdir \e
[file dirname [file normalize [info script]]]
diff --git a/doc/zlib.n b/doc/zlib.n
index fd29e0d..3714fc1 100644
--- a/doc/zlib.n
+++ b/doc/zlib.n
@@ -193,10 +193,18 @@ How hard to compress the data. Must be an integer from 0 (uncompressed) to 9
.TP
\fB\-limit\fI readaheadLimit\fR
.
-The maximum number of bytes ahead to read when decompressing. This defaults to
-1, which ensures that data is always decompressed correctly, but may be
-increased to improve performance. This is more useful when the channel is
-non-blocking.
+The maximum number of bytes ahead to read when decompressing.
+.RS
+.PP
+This option has become \fBirrelevant\fR. It was originally introduced
+to prevent Tcl from reading beyond the end of a compressed stream in
+multi-stream channels to ensure that the data after was left alone for
+further reading, at the cost of speed.
+.PP
+Tcl now automatically returns any bytes it has read beyond the end of
+a compressed stream back to the channel, making them appear as unread
+to further readers.
+.RE
.PP
Both compressing and decompressing channel transformations add extra
configuration options that may be accessed through \fBchan configure\fR. The
@@ -238,10 +246,8 @@ off the data stream.
\fB\-limit\fI readaheadLimit\fR
.
This read-write option is used by decompressing channels to control the
-maximum number of bytes ahead to read from the underlying data source. This
-defaults to 1, which ensures that data is always decompressed correctly, but
-may be increased to improve performance. This is more useful when the channel
-is non-blocking.
+maximum number of bytes ahead to read from the underlying data source. See
+above for more information.
.RE
.SS "STREAMING SUBCOMMAND"
.TP
diff --git a/generic/regexec.c b/generic/regexec.c
index b5f161b..e7260cd 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -73,7 +73,7 @@ struct dfa {
chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
struct sset *search; /* replacement-search-pointer memory */
int cptsmalloced; /* were the areas individually malloced? */
- char *mallocarea; /* self, or master malloced area, or NULL */
+ char *mallocarea; /* self, or malloced area, or NULL */
};
#define WORK 1 /* number of work bitvectors needed */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 0e172cb..93f3ff4 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -316,12 +316,12 @@ declare 85 {
int flags)
}
declare 86 {
- int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
+ int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd,
Tcl_Interp *target, const char *targetCmd, int argc,
const char *const *argv)
}
declare 87 {
- int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
+ int Tcl_CreateAliasObj(Tcl_Interp *childInterp, const char *childCmd,
Tcl_Interp *target, const char *targetCmd, int objc,
Tcl_Obj *const objv[])
}
@@ -364,7 +364,7 @@ declare 96 {
Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
- Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
+ Tcl_Interp *Tcl_CreateChild(Tcl_Interp *interp, const char *name,
int isSafe)
}
declare 98 {
@@ -527,12 +527,12 @@ declare 147 {deprecated {see TIP #559. Use Tcl_ResetResult}} {
void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 {
- int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
+ int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *argcPtr, const char ***argvPtr)
}
declare 149 {
- int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
+ int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
@@ -582,10 +582,10 @@ declare 162 {
const char *Tcl_GetHostName(void)
}
declare 163 {
- int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
+ int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp)
}
declare 164 {
- Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
+ Tcl_Interp *Tcl_GetParent(Tcl_Interp *interp)
}
declare 165 {
const char *Tcl_GetNameOfExecutable(void)
@@ -616,7 +616,7 @@ declare 171 {
int Tcl_GetServiceMode(void)
}
declare 172 {
- Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
+ Tcl_Interp *Tcl_GetChild(Tcl_Interp *interp, const char *name)
}
declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
diff --git a/generic/tcl.h b/generic/tcl.h
index 369a894..65169c0 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -973,11 +973,14 @@ typedef struct Tcl_DString {
#define TCL_DONT_QUOTE_HASH 8
/*
- * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
- * abbreviated strings.
+ * Flags that may be passed to Tcl_GetIndexFromObj.
+ * TCL_EXACT disallows abbreviated strings.
+ * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is
+ * a table that will not live long enough to make it worthwhile.
*/
-#define TCL_EXACT 1
+#define TCL_EXACT 1
+#define TCL_INDEX_TEMP_TABLE 2
/*
*----------------------------------------------------------------------------
@@ -2114,8 +2117,8 @@ typedef struct Tcl_EncodingType {
* The maximum number of bytes that are necessary to represent a single
* Unicode character in UTF-8. The valid values are 3 and 4
* (or perhaps 1 if we want to support a non-unicode enabled core). If 3,
- * then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If > 3,
- * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
+ * then Tcl_UniChar must be 2-bytes in size (UTF-16) (the default). If > 3,
+ * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UTF-16 mode
* is the default and recommended mode.
*/
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 3a76469..bc4716d 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -345,7 +345,7 @@ TclpAlloc(
nextf[bucket] = overPtr->next;
overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
- overPtr->bucketIndex = (unsigned char) bucket;
+ overPtr->bucketIndex = UCHAR(bucket);
#ifdef MSTATS
numMallocs[bucket]++;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6c14f45..75f8527 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -684,7 +684,7 @@ Tcl_CreateInterp(void)
TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
- TclRegisterCommandTypeName(TclSlaveObjCmd, "slave");
+ TclRegisterCommandTypeName(TclChildObjCmd, "interp");
TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
@@ -2785,6 +2785,8 @@ TclCreateObjCommandInNs(
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+ cmdPtr->refCount++;
+ TclCleanupCommandMacro(dataPtr->realCmdPtr);
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
@@ -3374,7 +3376,7 @@ Tcl_GetCommandFullName(
* separator, and the command name.
*/
- if (cmdPtr != NULL) {
+ if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) {
if (cmdPtr->nsPtr != NULL) {
Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
@@ -3464,7 +3466,7 @@ Tcl_DeleteCommandFromToken(
* and skip nested deletes.
*/
- if (cmdPtr->flags & CMD_IS_DELETED) {
+ if (cmdPtr->flags & CMD_DYING) {
/*
* Another deletion is already in progress. Remove the hash table
* entry now, but don't invoke a callback or free the command
@@ -3496,7 +3498,7 @@ Tcl_DeleteCommandFromToken(
* be ignored.
*/
- cmdPtr->flags |= CMD_IS_DELETED;
+ cmdPtr->flags |= CMD_DYING;
/*
* Call trace functions for the command being deleted. Then delete its
@@ -3526,7 +3528,7 @@ Tcl_DeleteCommandFromToken(
}
/*
- * The list of command exported from the namespace might have changed.
+ * The list of commands exported from the namespace might have changed.
* However, we do not need to recompute this just yet; next time we need
* the info will be soon enough.
*/
@@ -3547,6 +3549,19 @@ Tcl_DeleteCommandFromToken(
iPtr->compileEpoch++;
}
+ if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
+ /*
+ * Delete any imports of this routine before deleting this routine itself.
+ * See issue 688fcc7082fa.
+ */
+ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
+ refPtr = nextRefPtr) {
+ nextRefPtr = refPtr->nextPtr;
+ importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+ Tcl_DeleteCommandFromToken(interp, importCmd);
+ }
+ }
+
if (cmdPtr->deleteProc != NULL) {
/*
* Delete the command's client data. If this was an imported command
@@ -3567,20 +3582,6 @@ Tcl_DeleteCommandFromToken(
}
/*
- * If this command was imported into other namespaces, then imported
- * commands were created that refer back to this command. Delete these
- * imported commands now.
- */
- if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
- for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
- refPtr = nextRefPtr) {
- nextRefPtr = refPtr->nextPtr;
- importCmd = (Tcl_Command) refPtr->importedCmdPtr;
- Tcl_DeleteCommandFromToken(interp, importCmd);
- }
- }
-
- /*
* Don't use hPtr to delete the hash entry here, because it's possible
* that the deletion callback renamed the command. Instead, use
* cmdPtr->hptr, and make sure that no-one else has already deleted the
@@ -3617,6 +3618,7 @@ Tcl_DeleteCommandFromToken(
* TclNRExecuteByteCode looks up the command in the command hashtable).
*/
+ cmdPtr->flags |= CMD_DEAD;
TclCleanupCommandMacro(cmdPtr);
return 0;
}
@@ -3661,7 +3663,7 @@ CallCommandTraces(
* While a rename trace is active, we will not process any more rename
* traces; while a delete trace is active we will never reach here -
* because Tcl_DeleteCommandFromToken checks for the condition
- * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a
+ * (cmdPtr->flags & CMD_DYING) and returns immediately when a
* command deletion is in progress. For all other traces, delete
* traces will not be invoked but a call to TraceCommandProc will
* ensure that tracePtr->clientData is freed whenever the command
@@ -3792,11 +3794,11 @@ CancelEvalProc(
TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
/*
- * Now, we must set the script cancellation flags on all the slave
+ * Now, we must set the script cancellation flags on all the child
* interpreters belonging to this one.
*/
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
+ TclSetChildCancelFlags((Tcl_Interp *) iPtr,
cancelInfo->flags | CANCELED, 0);
/*
@@ -4321,7 +4323,7 @@ TclResetCancellation(
* Tcl_Canceled --
*
* Check if the script in progress has been canceled, i.e.,
- * Tcl_CancelEval was called for this interpreter or any of its master
+ * Tcl_CancelEval was called for this interpreter or any of its parent
* interpreters.
*
* Results:
@@ -4686,7 +4688,7 @@ EvalObjvCore(
* Caller gave it to us.
*/
- if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
+ if (!(preCmdPtr->flags & CMD_DEAD)) {
/*
* So long as it exists, use it.
*/
@@ -5214,7 +5216,7 @@ TEOV_RunLeaveTraces(
int length;
const char *command = TclGetStringFromObj(commandPtr, &length);
- if (!(cmdPtr->flags & CMD_IS_DELETED)) {
+ if (!(cmdPtr->flags & CMD_DYING)) {
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -5407,7 +5409,7 @@ TclEvalEx(
* the embedded command, which is refered to
* by 'script'. The 'clNextOuter' refers to
* the current entry in the table of
- * continuation lines in this "master script",
+ * continuation lines in this "main script",
* and the character offsets are relative to
* the 'outerScript' as well.
*
@@ -6460,7 +6462,7 @@ TclNREvalObjEx(
/*
* Shimmer protection! Always pass an unshared obj. The caller could
* incr the refCount of objPtr AFTER calling us! To be completely safe
- * we always make a copy. The callback takes care od the refCounts for
+ * we always make a copy. The callback takes care of the refCounts for
* both listPtr and objPtr.
*
* TODO: Create a test to demo this need, or eliminate it.
@@ -7029,7 +7031,7 @@ TclObjInvoke(
int
TclNRInvoke(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -7511,7 +7513,7 @@ Tcl_GetVersion(
static int
ExprCeilFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -7551,7 +7553,7 @@ ExprCeilFunc(
static int
ExprFloorFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -7591,7 +7593,7 @@ ExprFloorFunc(
static int
ExprIsqrtFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute. */
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter list. */
@@ -7697,7 +7699,7 @@ ExprIsqrtFunc(
static int
ExprSqrtFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -7865,7 +7867,7 @@ ExprBinaryFunc(
static int
ExprAbsFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -7964,7 +7966,7 @@ ExprAbsFunc(
static int
ExprBoolFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -7985,7 +7987,7 @@ ExprBoolFunc(
static int
ExprDoubleFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8012,7 +8014,7 @@ ExprDoubleFunc(
static int
ExprIntFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8068,7 +8070,7 @@ ExprIntFunc(
static int
ExprWideFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8089,7 +8091,7 @@ ExprWideFunc(
*/
static int
ExprMaxMinFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8129,7 +8131,7 @@ ExprMaxMinFunc(
static int
ExprMaxFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8140,7 +8142,7 @@ ExprMaxFunc(
static int
ExprMinFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8151,7 +8153,7 @@ ExprMinFunc(
static int
ExprRandFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8244,7 +8246,7 @@ ExprRandFunc(
static int
ExprRoundFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8323,7 +8325,7 @@ ExprRoundFunc(
static int
ExprSrandFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
@@ -8512,7 +8514,7 @@ ClassifyDouble(
static int
ExprIsFiniteFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8543,7 +8545,7 @@ ExprIsFiniteFunc(
static int
ExprIsInfinityFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8573,7 +8575,7 @@ ExprIsInfinityFunc(
static int
ExprIsNaNFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8603,7 +8605,7 @@ ExprIsNaNFunc(
static int
ExprIsNormalFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8633,7 +8635,7 @@ ExprIsNormalFunc(
static int
ExprIsSubnormalFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8663,7 +8665,7 @@ ExprIsSubnormalFunc(
static int
ExprIsUnorderedFunc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8704,7 +8706,7 @@ ExprIsUnorderedFunc(
static int
FloatClassifyObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count */
@@ -8813,7 +8815,7 @@ MathFuncWrongNumArgs(
static int
DTraceObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -9197,7 +9199,7 @@ TclSetTailcall(
int
TclNRTailcallObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -9390,7 +9392,7 @@ TclNRYieldObjCmd(
int
TclNRYieldToObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -9513,7 +9515,7 @@ NRCoroutineCallerCallback(
SAVE_CONTEXT(corPtr->running);
RESTORE_CONTEXT(corPtr->caller);
- if (cmdPtr->flags & CMD_IS_DELETED) {
+ if (cmdPtr->flags & CMD_DYING) {
/*
* The command was deleted while it was running: wind down the
* execEnv, this will do the complete cleanup. RewindCoroutine will
@@ -9700,7 +9702,7 @@ TclNREvalList(
static int
CoroTypeObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -9790,7 +9792,7 @@ GetCoroutineFromObj(
static int
TclNRCoroInjectObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -9835,7 +9837,7 @@ TclNRCoroInjectObjCmd(
static int
TclNRCoroProbeObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -10028,7 +10030,7 @@ InjectHandlerPostCall(
static int
NRInjectObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -10137,7 +10139,7 @@ TclNRInterpCoroutine(
int
TclNRCoroutineObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -10270,7 +10272,7 @@ TclNRCoroutineObjCmd(
int
TclInfoCoroutineCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -10282,7 +10284,7 @@ TclInfoCoroutineCmd(
return TCL_ERROR;
}
- if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+ if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
Tcl_Obj *namePtr;
TclNewObj(namePtr);
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 2d1d4d8..806bd58 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -274,7 +274,7 @@ typedef struct ByteArray {
* array. */
unsigned int allocated; /* The amount of space actually allocated
* minus 1 byte. */
- unsigned char bytes[1]; /* The array of bytes. The actual size of this
+ unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
* above. */
} ByteArray;
@@ -2841,7 +2841,7 @@ BinaryEncodeUu(
unsigned char *data, *start, *cursor;
int offset, count, rawLength, n, i, j, bits, index;
int lineLength = 61;
- const unsigned char SingleNewline[] = { (unsigned char) '\n' };
+ const unsigned char SingleNewline[] = { UCHAR('\n') };
const unsigned char *wrapchar = SingleNewline;
int wrapcharlen = sizeof(SingleNewline);
enum { OPT_MAXLEN, OPT_WRAPCHAR };
diff --git a/generic/tclClock.c b/generic/tclClock.c
index baaa568..ba85fec 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -263,7 +263,7 @@ TclClockInit(
};
/*
- * Safe interps get [::clock] as alias to a master, so do not need their
+ * Safe interps get [::clock] as alias to a parent, so do not need their
* own copies of the support routines.
*/
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 94ff2cc..3de976e 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1026,7 +1026,7 @@ InfoErrorStackCmd(
target = interp;
if (objc == 2) {
- target = Tcl_GetSlave(interp, TclGetString(objv[1]));
+ target = Tcl_GetChild(interp, TclGetString(objv[1]));
if (target == NULL) {
return TCL_ERROR;
}
@@ -2142,7 +2142,7 @@ InfoCmdTypeCmd(
}
/*
- * There's one special case: safe slave interpreters can't see aliases as
+ * There's one special case: safe child interpreters can't see aliases as
* aliases as they're part of the security mechanisms.
*/
@@ -3305,7 +3305,7 @@ Tcl_LsearchObjCmd(
if (groupSize < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"stride length must be at least 1", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
"BADSTRIDE", NULL);
result = TCL_ERROR;
goto done;
@@ -3640,11 +3640,11 @@ Tcl_LsearchObjCmd(
/*
* Normally, binary search is written to stop when it finds a
* match. If there are duplicates of an element in the list,
- * our first match might not be the first occurance.
+ * our first match might not be the first occurrence.
* Consider: 0 0 0 1 1 1 2 2 2
*
* To maintain consistancy with standard lsearch semantics, we
- * must find the leftmost occurance of the pattern in the
+ * must find the leftmost occurrence of the pattern in the
* list. Thus we don't just stop searching here. This
* variation means that a search always makes log n
* comparisons (normal binary search might "get lucky" with an
@@ -4697,7 +4697,7 @@ static int
DictionaryCompare(
const char *left, const char *right) /* The strings to compare. */
{
- Tcl_UniChar uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower;
+ int uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower;
int diff, zeros;
int secondaryDiff = 0;
@@ -4766,8 +4766,8 @@ DictionaryCompare(
*/
if ((*left != '\0') && (*right != '\0')) {
- left += TclUtfToUniChar(left, &uniLeft);
- right += TclUtfToUniChar(right, &uniRight);
+ left += TclUtfToUCS4(left, &uniLeft);
+ right += TclUtfToUCS4(right, &uniRight);
/*
* Convert both chars to lower for the comparison, because
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d7394fb..f95dd12 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -195,7 +195,7 @@ Tcl_RegexpObjCmd(
if (++i >= objc) {
goto endOfForLoop;
}
- if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) {
+ if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, &temp) != TCL_OK) {
goto optionError;
}
if (startIndex) {
@@ -550,7 +550,7 @@ Tcl_RegsubObjCmd(
if (++idx >= objc) {
goto endOfForLoop;
}
- if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) {
+ if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, &temp) != TCL_OK) {
goto optionError;
}
if (startIndex) {
@@ -1424,7 +1424,7 @@ StringIndexCmd(
*/
if (TclIsPureByteArray(objv[1])) {
- unsigned char uch = (unsigned char) ch;
+ unsigned char uch = UCHAR(ch);
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
} else {
@@ -4311,7 +4311,7 @@ Tcl_TimeRateObjCmd(
*/
measureOverhead = 0;
- Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
return TCL_OK;
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index e38be07..3e2da23 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -126,9 +126,9 @@ TclCompileAppendCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isScalar, localIndex, numWords, i;
- DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
@@ -390,9 +390,9 @@ TclCompileArraySetCmd(
keyVar = AnonymousLocal(envPtr);
valVar = AnonymousLocal(envPtr);
- infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo));
+ infoPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
infoPtr->numLists = 1;
- infoPtr->varLists[0] = (ForeachVarList *)ckalloc(sizeof(ForeachVarList) + sizeof(int));
+ infoPtr->varLists[0] = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(int));
infoPtr->varLists[0]->numVars = 2;
infoPtr->varLists[0]->varIndexes[0] = keyVar;
infoPtr->varLists[0]->varIndexes[1] = valVar;
@@ -572,10 +572,10 @@ TclCompileCatchCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
int resultIndex, optsIndex, range, dropScript = 0;
- DefineLineInformation; /* TIP #280 */
int depth = TclGetStackDepth(envPtr);
/*
@@ -1003,9 +1003,9 @@ TclCompileDictSetCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i, dictVarIndex;
- DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
/*
@@ -1128,9 +1128,9 @@ TclCompileDictGetCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i;
- DefineLineInformation; /* TIP #280 */
/*
* There must be at least two arguments after the command (the single-arg
@@ -1164,9 +1164,9 @@ TclCompileDictGetWithDefaultCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i;
- DefineLineInformation; /* TIP #280 */
/*
* There must be at least three arguments after the command.
@@ -1195,9 +1195,9 @@ TclCompileDictExistsCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i;
- DefineLineInformation; /* TIP #280 */
/*
* There must be at least two arguments after the command (the single-arg
@@ -1232,8 +1232,8 @@ TclCompileDictUnsetCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
int i, dictVarIndex;
/*
@@ -1789,7 +1789,7 @@ TclCompileDictUpdateCmd(
* that are to be used.
*/
- duiPtr = (DictUpdateInfo *)ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
+ duiPtr = (DictUpdateInfo *)ckalloc(offsetof(DictUpdateInfo, varIndices) + sizeof(int) * numVars);
duiPtr->length = numVars;
keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
tokenPtr = TokenAfter(dictVarTokenPtr);
@@ -2271,7 +2271,7 @@ DupDictUpdateInfo(
size_t len;
dui1Ptr = (DictUpdateInfo *)clientData;
- len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
+ len = offsetof(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length;
dui2Ptr = (DictUpdateInfo *)ckalloc(len);
memcpy(dui2Ptr, dui1Ptr, len);
return dui2Ptr;
@@ -2347,13 +2347,13 @@ TclCompileErrorCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
*/
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
-
if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
@@ -2464,11 +2464,11 @@ TclCompileForCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange;
- DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 5) {
return TCL_ERROR;
@@ -2676,6 +2676,7 @@ CompileEachloopCmd(
int collect) /* Select collecting or accumulating mode
* (TCL_EACH_*) */
{
+ DefineLineInformation; /* TIP #280 */
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
@@ -2685,7 +2686,6 @@ CompileEachloopCmd(
int jumpBackOffset, infoIndex, range;
int numWords, numLists, i, j, code = TCL_OK;
Tcl_Obj *varListObj = NULL;
- DefineLineInformation; /* TIP #280 */
/*
* If the foreach command isn't in a procedure, don't compile it inline:
@@ -2721,8 +2721,8 @@ CompileEachloopCmd(
*/
numLists = (numWords - 2)/2;
- infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)
- + (numLists - 1) * sizeof(ForeachVarList *));
+ infoPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists)
+ + numLists * sizeof(ForeachVarList *));
infoPtr->numLists = 0; /* Count this up as we go */
/*
@@ -2755,8 +2755,8 @@ CompileEachloopCmd(
goto done;
}
- varListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList)
- + (numVars - 1) * sizeof(int));
+ varListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes)
+ + numVars * sizeof(int));
varListPtr->numVars = numVars;
infoPtr->varLists[i/2] = varListPtr;
infoPtr->numLists++;
@@ -2891,7 +2891,7 @@ DupForeachInfo(
ForeachVarList *srcListPtr, *dupListPtr;
int numVars, i, j, numLists = srcPtr->numLists;
- dupPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)
+ dupPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists)
+ numLists * sizeof(ForeachVarList *));
dupPtr->numLists = numLists;
dupPtr->firstValueTemp = srcPtr->firstValueTemp;
@@ -2900,7 +2900,7 @@ DupForeachInfo(
for (i = 0; i < numLists; i++) {
srcListPtr = srcPtr->varLists[i];
numVars = srcListPtr->numVars;
- dupListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList)
+ dupListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes)
+ numVars * sizeof(int));
dupListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
@@ -3446,10 +3446,10 @@ TclPushVarName(
/*
* last char is ')' => potential array reference.
*/
- last = Tcl_UtfPrev(name + nameLen, name);
+ last = &name[nameLen-1];
if (*last == ')') {
- for (p = name; p < last; p = Tcl_UtfNext(p)) {
+ for (p = name; p < last; p++) {
if (*p == '(') {
elName = p + 1;
elNameLen = last - elName;
@@ -3477,15 +3477,14 @@ TclPushVarName(
} else if (interp && ((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
- && (*((p = varTokenPtr[n].start + varTokenPtr[n].size)-1) == ')')
- && (*Tcl_UtfPrev(p, varTokenPtr[n].start) == ')')) {
+ && (*(varTokenPtr[n].start + varTokenPtr[n].size - 1) == ')')) {
/*
* Check for parentheses inside first token.
*/
simpleVarName = 0;
for (p = varTokenPtr[1].start,
- last = p + varTokenPtr[1].size; p < last; p = Tcl_UtfNext(p)) {
+ last = p + varTokenPtr[1].size; p < last; p++) {
if (*p == '(') {
simpleVarName = 1;
break;
@@ -3553,7 +3552,7 @@ TclPushVarName(
int hasNsQualifiers = 0;
- for (p = name, last = p + nameLen-1; p < last; p = Tcl_UtfNext(p)) {
+ for (p = name, last = p + nameLen-1; p < last; p++) {
if ((*p == ':') && (*(p+1) == ':')) {
hasNsQualifiers = 1;
break;
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 59eebae..3361d7f 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -89,9 +89,9 @@ TclCompileGlobalCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
int localIndex, numWords, i;
- DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
@@ -170,6 +170,7 @@ TclCompileIfCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
JumpFixupArray jumpFalseFixupArray;
/* Used to fix the ifFalse jump after each
* test when its target PC is determined. */
@@ -185,7 +186,6 @@ TclCompileIfCmd(
* "if 0 {..}" */
int boolVal; /* Value of static condition. */
int compileScripts = 1;
- DefineLineInformation; /* TIP #280 */
/*
* Only compile the "if" command if all arguments are simple words, in
@@ -472,9 +472,9 @@ TclCompileIncrCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *incrTokenPtr;
int isScalar, localIndex, haveImmValue, immValue;
- DefineLineInformation; /* TIP #280 */
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
return TCL_ERROR;
@@ -667,9 +667,9 @@ TclCompileInfoExistsCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int isScalar, localIndex;
- DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -840,9 +840,9 @@ TclCompileLappendCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isScalar, localIndex, numWords, i;
- DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
@@ -955,9 +955,9 @@ TclCompileLassignCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int isScalar, localIndex, numWords, idx;
- DefineLineInformation; /* TIP #280 */
numWords = parsePtr->numWords;
@@ -1058,9 +1058,9 @@ TclCompileLindexCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *idxTokenPtr, *valTokenPtr;
int i, idx, numWords = parsePtr->numWords;
- DefineLineInformation; /* TIP #280 */
/*
* Quit if too few args.
@@ -1261,8 +1261,8 @@ TclCompileLlengthCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *varTokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *varTokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -1293,8 +1293,8 @@ TclCompileLrangeCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
- Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *listTokenPtr;
int idx1, idx2;
if (parsePtr->numWords != 4) {
@@ -1353,8 +1353,8 @@ TclCompileLinsertCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
- Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *listTokenPtr;
int idx, i;
if (parsePtr->numWords < 3) {
@@ -1455,8 +1455,8 @@ TclCompileLreplaceCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
- Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *listTokenPtr;
int idx1, idx2, i;
int emptyPrefix=1, suffixStart = 0;
@@ -1618,6 +1618,7 @@ TclCompileLsetCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
int tempDepth; /* Depth used for emitting one part of the
* code burst. */
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
@@ -1625,7 +1626,6 @@ TclCompileLsetCmd(
int localIndex; /* Index of var in local var table. */
int isScalar; /* Flag == 1 if scalar, 0 if array. */
int i;
- DefineLineInformation; /* TIP #280 */
/*
* Check argument count.
@@ -1788,8 +1788,8 @@ TclCompileNamespaceCodeCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -1837,8 +1837,8 @@ TclCompileNamespaceOriginCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -1858,8 +1858,8 @@ TclCompileNamespaceQualifiersCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
int off;
if (parsePtr->numWords != 2) {
@@ -1893,8 +1893,8 @@ TclCompileNamespaceTailCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
JumpFixup jumpFixup;
if (parsePtr->numWords != 2) {
@@ -1929,9 +1929,9 @@ TclCompileNamespaceUpvarCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
- DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
return TCL_ERROR;
@@ -2052,11 +2052,11 @@ TclCompileRegexpCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
* parse of the RE or string. */
int i, len, nocase, exact, sawLast, simple;
const char *str;
- DefineLineInformation; /* TIP #280 */
/*
* We are only interested in compiling simple regexp cases. Currently
@@ -2390,6 +2390,7 @@ TclCompileReturnCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
/*
* General syntax: [return ?-option value ...? ?result?]
* An even number of words means an explicit result argument is present.
@@ -2400,7 +2401,6 @@ TclCompileReturnCmd(
int numOptionWords = numWords - 1 - explicitResult;
Tcl_Obj *returnOpts, **objv;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
- DefineLineInformation; /* TIP #280 */
/*
* Check for special case which can always be compiled:
@@ -2641,9 +2641,9 @@ TclCompileUpvarCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
- DefineLineInformation; /* TIP #280 */
Tcl_Obj *objPtr;
if (envPtr->procPtr == NULL) {
@@ -2747,9 +2747,9 @@ TclCompileVariableCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int localIndex, numWords, i;
- DefineLineInformation; /* TIP #280 */
numWords = parsePtr->numWords;
if (numWords < 2) {
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 081b141..81c01e0 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -129,9 +129,9 @@ TclCompileSetCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, localIndex, numWords;
- DefineLineInformation; /* TIP #280 */
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
@@ -222,10 +222,10 @@ TclCompileStringCatCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
int i, numWords = parsePtr->numWords, numArgs;
Tcl_Token *wordTokenPtr;
Tcl_Obj *obj, *folded;
- DefineLineInformation; /* TIP #280 */
/* Trivial case, no arg */
@@ -444,8 +444,8 @@ TclCompileStringInsertCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
int idx;
if (parsePtr->numWords != 4) {
@@ -1046,8 +1046,8 @@ TclCompileStringReplaceCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
- Tcl_Token *tokenPtr, *valueTokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *valueTokenPtr;
int first, last;
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
@@ -1415,7 +1415,7 @@ StringClassDesc const tclStringClassTable[] = {
{"upper", Tcl_UniCharIsUpper},
{"word", Tcl_UniCharIsWordChar},
{"xdigit", UniCharIsHexDigit},
- {NULL, NULL}
+ {"", NULL}
};
/*
@@ -1446,13 +1446,13 @@ TclCompileSubstCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
int numArgs = parsePtr->numWords - 1;
int numOpts = numArgs - 1;
int objc, flags = TCL_SUBST_ALL;
Tcl_Obj **objv/*, *toSubst = NULL*/;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
int code = TCL_ERROR;
- DefineLineInformation; /* TIP #280 */
if (numArgs == 0) {
return TCL_ERROR;
@@ -1778,6 +1778,7 @@ TclCompileSwitchCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr; /* Pointer to tokens in command. */
int numWords; /* Number of words in command. */
@@ -1794,7 +1795,6 @@ TclCompileSwitchCmd(
int foundMode = 0; /* Have we seen a mode flag yet? */
int i, valueIndex;
int result = TCL_ERROR;
- DefineLineInformation; /* TIP #280 */
int *clNext = envPtr->clNext;
/*
@@ -3610,9 +3610,9 @@ TclCompileUnsetCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
- DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
@@ -3747,13 +3747,13 @@ TclCompileWhileCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Token *testTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
* infinite loop. */
Tcl_Obj *boolObj;
- DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 3) {
return TCL_ERROR;
@@ -4009,8 +4009,8 @@ CompileUnaryOpCmd(
int instruction,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -4051,8 +4051,8 @@ CompileAssociativeBinaryOpCmd(
int instruction,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/* TODO: Consider support for compiling expanded args. */
@@ -4136,8 +4136,8 @@ CompileComparisonOpCmd(
int instruction,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
@@ -4290,15 +4290,15 @@ TclCompilePowOpCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ int words;
+
/*
* This one has its own implementation because the ** operator is the only
* one with right associativity.
*/
- Tcl_Token *tokenPtr = parsePtr->tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
for (words=1 ; words<parsePtr->numWords ; words++) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, words);
@@ -4491,8 +4491,8 @@ TclCompileMinusOpCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/* TODO: Consider support for compiling expanded args. */
@@ -4536,8 +4536,8 @@ TclCompileDivOpCmd(
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/* TODO: Consider support for compiling expanded args. */
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 4fb41fc..74610c7 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2725,7 +2725,7 @@ TclVariadicOpCmd(
Tcl_Obj *const *litObjPtrPtr = litObjv;
if (lexeme == EXPON) {
- litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
+ TclNewIntObj(litObjv[1], occdPtr->i.identity);
Tcl_IncrRefCount(litObjv[1]);
decrMe = 1;
litObjv[0] = objv[1];
@@ -2741,7 +2741,7 @@ TclVariadicOpCmd(
if (lexeme == DIVIDE) {
litObjv[0] = Tcl_NewDoubleObj(1.0);
} else {
- litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
+ TclNewIntObj(litObjv[0], occdPtr->i.identity);
}
Tcl_IncrRefCount(litObjv[0]);
litObjv[1] = objv[1];
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5d4555e..7d67e12 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -848,7 +848,7 @@ TclSetByteCodeFromAny(
* faster code in some cases, and more compact code in more.
*/
- if (Tcl_GetMaster(interp) == NULL &&
+ if (Tcl_GetParent(interp) == NULL &&
!Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
&& IsCompactibleCompileEnv(&compEnv)) {
TclFreeCompileEnv(&compEnv);
@@ -1834,7 +1834,7 @@ CompileCmdLiteral(
bytes = TclGetStringFromObj(cmdObj, &numBytes);
cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);
- if (cmdPtr) {
+ if (cmdPtr && TclRoutineHasName(cmdPtr)) {
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
}
TclEmitPush(cmdLitIdx, envPtr);
@@ -1848,8 +1848,8 @@ TclCompileInvocation(
int numWords,
CompileEnv *envPtr)
{
- int wordIdx = 0, depth = TclGetStackDepth(envPtr);
DefineLineInformation;
+ int wordIdx = 0, depth = TclGetStackDepth(envPtr);
if (cmdObj) {
CompileCmdLiteral(interp, cmdObj, envPtr);
@@ -1892,8 +1892,8 @@ CompileExpanded(
int numWords,
CompileEnv *envPtr)
{
- int wordIdx = 0;
DefineLineInformation;
+ int wordIdx = 0;
int depth = TclGetStackDepth(envPtr);
StartExpanding(envPtr);
@@ -1951,8 +1951,8 @@ CompileCmdCompileProc(
Command *cmdPtr,
CompileEnv *envPtr)
{
- int unwind = 0, incrOffset = -1;
DefineLineInformation;
+ int unwind = 0, incrOffset = -1;
int depth = TclGetStackDepth(envPtr);
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5e39a21..21a27f7 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -927,7 +927,7 @@ typedef enum InstStringClassType {
} InstStringClassType;
typedef struct StringClassDesc {
- const char *name; /* Name of the class. */
+ char name[8]; /* Name of the class. */
int (*comparator)(int); /* Function to test if a single unicode
* character is a member of the class. */
} StringClassDesc;
@@ -991,7 +991,7 @@ typedef struct JumpFixupArray {
typedef struct ForeachVarList {
int numVars; /* The number of variables in the list. */
- int varIndexes[1]; /* An array of the indexes ("slot numbers")
+ int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")
* for each variable in the procedure's array
* of local variables. Only scalar variables
* are supported. The actual size of this
@@ -1015,7 +1015,7 @@ typedef struct ForeachInfo {
* the loop's iteration count. Used to
* determine next value list element to assign
* each loop var. */
- ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
+ ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList
* structures describing each var list. The
* actual size of this field will be large
* enough to numVars indexes. THIS MUST BE THE
@@ -1046,7 +1046,7 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType;
typedef struct {
int length; /* Size of array */
- int varIndices[1]; /* Array of variable indices to manage when
+ int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when
* processing the start and end of a [dict
* update]. There is really more than one
* entry, and the structure is allocated to
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 294d4fe..f8552a3 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -102,9 +102,6 @@ typedef enum _MERIDIAN {
MERam, MERpm, MER24
} MERIDIAN;
-
-
-
/*
* yyparse will accept a 'struct DateInfo' as its parameter; that's where the
* parsed fields will be returned.
@@ -210,6 +207,9 @@ typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
+
+
+
# ifndef YY_NULLPTR
# if defined __cplusplus && 201103L <= __cplusplus
# define YY_NULLPTR nullptr
@@ -560,7 +560,7 @@ union yyalloc
/* YYFINAL -- State number of the termination state. */
#define YYFINAL 2
/* YYLAST -- Last index in YYTABLE. */
-#define YYLAST 79
+#define YYLAST 81
/* YYNTOKENS -- Number of terminals. */
#define YYNTOKENS 26
@@ -569,7 +569,7 @@ union yyalloc
/* YYNRULES -- Number of rules. */
#define YYNRULES 56
/* YYNSTATES -- Number of states. */
-#define YYNSTATES 83
+#define YYNSTATES 85
/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
by yylex, with out-of-bounds checking. */
@@ -587,7 +587,7 @@ static const yytype_uint8 yytranslate[] =
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
- 2, 2, 2, 25, 22, 21, 24, 23, 2, 2,
+ 2, 2, 2, 25, 21, 23, 24, 22, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 20, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
@@ -618,11 +618,11 @@ static const yytype_uint8 yytranslate[] =
static const yytype_uint16 yyrline[] =
{
0, 223, 223, 224, 227, 230, 233, 236, 239, 242,
- 245, 249, 254, 257, 263, 269, 277, 283, 294, 298,
- 302, 308, 312, 316, 320, 324, 330, 334, 339, 344,
- 349, 354, 358, 363, 367, 372, 379, 383, 389, 398,
- 407, 417, 431, 436, 439, 442, 445, 448, 451, 456,
- 459, 464, 468, 472, 478, 496, 499
+ 245, 249, 254, 257, 263, 269, 277, 282, 287, 291,
+ 297, 301, 305, 309, 313, 319, 323, 328, 333, 338,
+ 343, 347, 352, 356, 361, 368, 372, 378, 388, 397,
+ 406, 416, 430, 435, 438, 441, 444, 447, 450, 455,
+ 458, 463, 467, 471, 477, 495, 498
};
#endif
@@ -634,7 +634,7 @@ static const char *const yytname[] =
"$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
"tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
"tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
- "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
+ "tDAY_UNIT", "tNEXT", "':'", "','", "'/'", "'-'", "'.'", "'+'",
"$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
"iso", "trek", "relspec", "relunits", "sign", "unit", "number",
"o_merid", YY_NULLPTR
@@ -648,14 +648,14 @@ static const yytype_uint16 yytoknum[] =
{
0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
- 58, 45, 44, 47, 46, 43
+ 58, 44, 47, 45, 46, 43
};
# endif
-#define YYPACT_NINF -22
+#define YYPACT_NINF -18
#define yypact_value_is_default(Yystate) \
- (!!((Yystate) == (-22)))
+ (!!((Yystate) == (-18)))
#define YYTABLE_NINF -1
@@ -666,15 +666,15 @@ static const yytype_uint16 yytoknum[] =
STATE-NUM. */
static const yytype_int8 yypact[] =
{
- -22, 2, -22, -21, -22, -4, -22, 1, -22, 22,
- 18, -22, 8, -22, 40, -22, -22, -22, -22, -22,
- -22, -22, -22, -22, -22, -22, 32, 28, -22, -22,
- -22, 24, 26, -22, -22, 42, 47, -5, 49, -22,
- -22, 15, -22, -22, -22, 48, -22, -22, 43, 50,
- 51, -22, 17, 44, 46, 45, 52, -22, -22, -22,
- -22, -22, -22, -22, -22, 56, 57, -22, 58, 60,
- 61, 62, -3, -22, -22, -22, -22, 59, 63, -22,
- 64, -22, -22
+ -18, 2, -18, -17, -18, -4, -18, 10, -18, 22,
+ 8, -18, 18, -18, 39, -18, -18, -18, -18, -18,
+ -18, -18, -18, -18, -18, -18, 25, 21, -18, -18,
+ -18, 16, 14, -18, -18, 28, 36, 41, -5, -18,
+ -18, 5, -18, -18, -18, 47, -18, -18, 42, 46,
+ 48, -18, -6, 40, 43, 44, 49, -18, -18, -18,
+ -18, -18, -18, -18, -18, 50, -18, 51, 55, 57,
+ 58, 65, -18, -18, 59, 54, -18, 62, 63, 60,
+ -18, 64, 61, 66, -18
};
/* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
@@ -682,29 +682,29 @@ static const yytype_int8 yypact[] =
means the default is an error. */
static const yytype_uint8 yydefact[] =
{
- 2, 0, 1, 21, 20, 0, 53, 0, 51, 54,
- 19, 34, 28, 52, 0, 49, 50, 3, 4, 5,
+ 2, 0, 1, 20, 18, 0, 53, 0, 51, 54,
+ 17, 33, 27, 52, 0, 49, 50, 3, 4, 5,
8, 6, 7, 10, 11, 9, 43, 0, 48, 12,
- 22, 31, 0, 23, 13, 33, 0, 0, 0, 45,
- 18, 0, 40, 25, 36, 0, 46, 42, 0, 0,
- 0, 35, 55, 0, 0, 26, 0, 38, 37, 47,
- 24, 44, 32, 41, 56, 0, 0, 14, 0, 0,
- 0, 0, 55, 15, 29, 30, 27, 0, 0, 16,
- 0, 17, 39
+ 21, 30, 0, 22, 13, 32, 0, 0, 0, 45,
+ 16, 0, 40, 24, 35, 0, 46, 42, 19, 0,
+ 0, 34, 55, 25, 0, 0, 0, 38, 36, 47,
+ 23, 44, 31, 41, 56, 0, 14, 0, 0, 0,
+ 0, 55, 26, 28, 29, 0, 15, 0, 0, 0,
+ 39, 0, 0, 0, 37
};
/* YYPGOTO[NTERM-NUM]. */
static const yytype_int8 yypgoto[] =
{
- -22, -22, -22, -22, -22, -22, -22, -22, -22, -22,
- -22, -22, -22, -9, -22, 6
+ -18, -18, -18, -18, -18, -18, -18, -18, -18, -18,
+ -18, -18, -18, -9, -18, 7
};
/* YYDEFGOTO[NTERM-NUM]. */
static const yytype_int8 yydefgoto[] =
{
-1, 1, 17, 18, 19, 20, 21, 22, 23, 24,
- 25, 26, 27, 28, 29, 67
+ 25, 26, 27, 28, 29, 66
};
/* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If
@@ -712,26 +712,28 @@ static const yytype_int8 yydefgoto[] =
number is the opposite. If YYTABLE_NINF, syntax error. */
static const yytype_uint8 yytable[] =
{
- 39, 30, 2, 53, 64, 46, 3, 4, 54, 31,
- 5, 6, 7, 8, 32, 9, 10, 11, 78, 12,
- 13, 14, 41, 15, 64, 42, 33, 16, 56, 34,
- 35, 6, 57, 8, 40, 47, 59, 65, 66, 61,
- 13, 48, 36, 37, 43, 38, 49, 60, 44, 6,
- 50, 8, 6, 45, 8, 51, 58, 6, 13, 8,
- 52, 13, 55, 62, 63, 68, 13, 69, 70, 72,
- 73, 74, 71, 75, 76, 77, 81, 82, 79, 80
+ 39, 64, 2, 54, 30, 46, 3, 4, 55, 31,
+ 5, 6, 7, 8, 65, 9, 10, 11, 56, 12,
+ 13, 14, 57, 32, 40, 15, 33, 16, 47, 34,
+ 35, 6, 41, 8, 48, 42, 59, 49, 50, 61,
+ 13, 51, 36, 43, 37, 38, 60, 44, 6, 52,
+ 8, 6, 45, 8, 53, 58, 6, 13, 8, 62,
+ 13, 63, 67, 71, 72, 13, 68, 69, 73, 70,
+ 74, 75, 64, 77, 78, 79, 80, 82, 76, 84,
+ 81, 83
};
static const yytype_uint8 yycheck[] =
{
- 9, 22, 0, 8, 7, 14, 4, 5, 13, 13,
- 8, 9, 10, 11, 13, 13, 14, 15, 21, 17,
- 18, 19, 14, 21, 7, 17, 4, 25, 13, 7,
- 8, 9, 17, 11, 16, 3, 45, 20, 21, 48,
- 18, 13, 20, 21, 4, 23, 22, 4, 8, 9,
- 24, 11, 9, 13, 11, 13, 8, 9, 18, 11,
- 13, 18, 13, 13, 13, 21, 18, 21, 23, 13,
- 13, 13, 20, 13, 13, 13, 13, 13, 72, 20
+ 9, 7, 0, 8, 21, 14, 4, 5, 13, 13,
+ 8, 9, 10, 11, 20, 13, 14, 15, 13, 17,
+ 18, 19, 17, 13, 16, 23, 4, 25, 3, 7,
+ 8, 9, 14, 11, 13, 17, 45, 21, 24, 48,
+ 18, 13, 20, 4, 22, 23, 4, 8, 9, 13,
+ 11, 9, 13, 11, 13, 8, 9, 18, 11, 13,
+ 18, 13, 22, 13, 13, 18, 23, 23, 13, 20,
+ 13, 13, 7, 14, 20, 13, 13, 13, 71, 13,
+ 20, 20
};
/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
@@ -739,23 +741,23 @@ static const yytype_uint8 yycheck[] =
static const yytype_uint8 yystos[] =
{
0, 27, 0, 4, 5, 8, 9, 10, 11, 13,
- 14, 15, 17, 18, 19, 21, 25, 28, 29, 30,
+ 14, 15, 17, 18, 19, 23, 25, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
- 22, 13, 13, 4, 7, 8, 20, 21, 23, 39,
- 16, 14, 17, 4, 8, 13, 39, 3, 13, 22,
- 24, 13, 13, 8, 13, 13, 13, 17, 8, 39,
- 4, 39, 13, 13, 7, 20, 21, 41, 21, 21,
- 23, 20, 13, 13, 13, 13, 13, 13, 21, 41,
- 20, 13, 13
+ 21, 13, 13, 4, 7, 8, 20, 22, 23, 39,
+ 16, 14, 17, 4, 8, 13, 39, 3, 13, 21,
+ 24, 13, 13, 13, 8, 13, 13, 17, 8, 39,
+ 4, 39, 13, 13, 7, 20, 41, 22, 23, 23,
+ 20, 13, 13, 13, 13, 13, 41, 14, 20, 13,
+ 13, 20, 13, 20, 13
};
/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
static const yytype_uint8 yyr1[] =
{
0, 26, 27, 27, 28, 28, 28, 28, 28, 28,
- 28, 28, 28, 29, 29, 29, 29, 29, 30, 30,
- 30, 31, 31, 31, 31, 31, 32, 32, 32, 32,
- 32, 32, 32, 32, 32, 32, 33, 33, 34, 34,
+ 28, 28, 28, 29, 29, 29, 30, 30, 30, 30,
+ 31, 31, 31, 31, 31, 32, 32, 32, 32, 32,
+ 32, 32, 32, 32, 32, 33, 33, 34, 34, 34,
34, 35, 36, 36, 37, 37, 37, 37, 37, 38,
38, 39, 39, 39, 40, 41, 41
};
@@ -764,9 +766,9 @@ static const yytype_uint8 yyr1[] =
static const yytype_uint8 yyr2[] =
{
0, 2, 0, 2, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 2, 4, 5, 6, 7, 2, 1,
- 1, 1, 2, 2, 3, 2, 3, 5, 1, 5,
- 5, 2, 4, 2, 1, 3, 2, 3, 3, 7,
+ 1, 1, 1, 2, 4, 6, 2, 1, 1, 2,
+ 1, 2, 2, 3, 2, 3, 5, 1, 5, 5,
+ 2, 4, 2, 1, 3, 2, 3, 11, 3, 7,
2, 4, 2, 1, 3, 2, 2, 3, 1, 1,
1, 1, 1, 1, 1, 0, 1
};
@@ -1639,12 +1641,10 @@ yyreduce:
case 15:
{
- yyHour = (yyvsp[-4].Number);
- yyMinutes = (yyvsp[-2].Number);
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
- ++yyHaveZone;
+ yyHour = (yyvsp[-5].Number);
+ yyMinutes = (yyvsp[-3].Number);
+ yySeconds = (yyvsp[-1].Number);
+ yyMeridian = (yyvsp[0].Meridian);
}
break;
@@ -1652,10 +1652,9 @@ yyreduce:
case 16:
{
- yyHour = (yyvsp[-5].Number);
- yyMinutes = (yyvsp[-3].Number);
- yySeconds = (yyvsp[-1].Number);
- yyMeridian = (yyvsp[0].Meridian);
+ yyTimezone = (yyvsp[-1].Number);
+ if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
+ yyDSTmode = DSTon;
}
break;
@@ -1663,13 +1662,9 @@ yyreduce:
case 17:
{
- yyHour = (yyvsp[-6].Number);
- yyMinutes = (yyvsp[-4].Number);
- yySeconds = (yyvsp[-2].Number);
- yyMeridian = MER24;
+ yyTimezone = (yyvsp[0].Number);
+ if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
yyDSTmode = DSToff;
- yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
- ++yyHaveZone;
}
break;
@@ -1677,7 +1672,7 @@ yyreduce:
case 18:
{
- yyTimezone = (yyvsp[-1].Number);
+ yyTimezone = (yyvsp[0].Number);
yyDSTmode = DSTon;
}
@@ -1686,7 +1681,7 @@ yyreduce:
case 19:
{
- yyTimezone = (yyvsp[0].Number);
+ yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
yyDSTmode = DSToff;
}
@@ -1695,22 +1690,13 @@ yyreduce:
case 20:
{
- yyTimezone = (yyvsp[0].Number);
- yyDSTmode = DSTon;
- }
-
- break;
-
- case 21:
-
- {
yyDayOrdinal = 1;
yyDayNumber = (yyvsp[0].Number);
}
break;
- case 22:
+ case 21:
{
yyDayOrdinal = 1;
@@ -1719,7 +1705,7 @@ yyreduce:
break;
- case 23:
+ case 22:
{
yyDayOrdinal = (yyvsp[-1].Number);
@@ -1728,7 +1714,7 @@ yyreduce:
break;
- case 24:
+ case 23:
{
yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
@@ -1737,7 +1723,7 @@ yyreduce:
break;
- case 25:
+ case 24:
{
yyDayOrdinal = 2;
@@ -1746,7 +1732,7 @@ yyreduce:
break;
- case 26:
+ case 25:
{
yyMonth = (yyvsp[-2].Number);
@@ -1755,7 +1741,7 @@ yyreduce:
break;
- case 27:
+ case 26:
{
yyMonth = (yyvsp[-4].Number);
@@ -1765,7 +1751,7 @@ yyreduce:
break;
- case 28:
+ case 27:
{
yyYear = (yyvsp[0].Number) / 10000;
@@ -1775,7 +1761,7 @@ yyreduce:
break;
- case 29:
+ case 28:
{
yyDay = (yyvsp[-4].Number);
@@ -1785,7 +1771,7 @@ yyreduce:
break;
- case 30:
+ case 29:
{
yyMonth = (yyvsp[-2].Number);
@@ -1795,7 +1781,7 @@ yyreduce:
break;
- case 31:
+ case 30:
{
yyMonth = (yyvsp[-1].Number);
@@ -1804,7 +1790,7 @@ yyreduce:
break;
- case 32:
+ case 31:
{
yyMonth = (yyvsp[-3].Number);
@@ -1814,7 +1800,7 @@ yyreduce:
break;
- case 33:
+ case 32:
{
yyMonth = (yyvsp[0].Number);
@@ -1823,7 +1809,7 @@ yyreduce:
break;
- case 34:
+ case 33:
{
yyMonth = 1;
@@ -1833,7 +1819,7 @@ yyreduce:
break;
- case 35:
+ case 34:
{
yyMonth = (yyvsp[-1].Number);
@@ -1843,7 +1829,7 @@ yyreduce:
break;
- case 36:
+ case 35:
{
yyMonthOrdinal = 1;
@@ -1852,7 +1838,7 @@ yyreduce:
break;
- case 37:
+ case 36:
{
yyMonthOrdinal = (yyvsp[-1].Number);
@@ -1861,10 +1847,24 @@ yyreduce:
break;
+ case 37:
+
+ {
+ if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT;
+ yyYear = (yyvsp[-10].Number);
+ yyMonth = (yyvsp[-8].Number);
+ yyDay = (yyvsp[-6].Number);
+ yyHour = (yyvsp[-4].Number);
+ yyMinutes = (yyvsp[-2].Number);
+ yySeconds = (yyvsp[0].Number);
+ }
+
+ break;
+
case 38:
{
- if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT;
+ if ((yyvsp[-1].Number) != HOUR( 7) + HOUR(100)) YYABORT;
yyYear = (yyvsp[-2].Number) / 10000;
yyMonth = ((yyvsp[-2].Number) % 10000)/100;
yyDay = (yyvsp[-2].Number) % 100;
@@ -1878,7 +1878,7 @@ yyreduce:
case 39:
{
- if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT;
+ if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT;
yyYear = (yyvsp[-6].Number) / 10000;
yyMonth = ((yyvsp[-6].Number) % 10000)/100;
yyDay = (yyvsp[-6].Number) % 100;
@@ -2459,31 +2459,31 @@ static const TABLE TimezoneTable[] = {
*/
static const TABLE MilitaryTable[] = {
- { "a", tZONE, -HOUR( 1) },
- { "b", tZONE, -HOUR( 2) },
- { "c", tZONE, -HOUR( 3) },
- { "d", tZONE, -HOUR( 4) },
- { "e", tZONE, -HOUR( 5) },
- { "f", tZONE, -HOUR( 6) },
- { "g", tZONE, -HOUR( 7) },
- { "h", tZONE, -HOUR( 8) },
- { "i", tZONE, -HOUR( 9) },
- { "k", tZONE, -HOUR(10) },
- { "l", tZONE, -HOUR(11) },
- { "m", tZONE, -HOUR(12) },
- { "n", tZONE, HOUR( 1) },
- { "o", tZONE, HOUR( 2) },
- { "p", tZONE, HOUR( 3) },
- { "q", tZONE, HOUR( 4) },
- { "r", tZONE, HOUR( 5) },
- { "s", tZONE, HOUR( 6) },
- { "t", tZONE, HOUR( 7) },
- { "u", tZONE, HOUR( 8) },
- { "v", tZONE, HOUR( 9) },
- { "w", tZONE, HOUR( 10) },
- { "x", tZONE, HOUR( 11) },
- { "y", tZONE, HOUR( 12) },
- { "z", tZONE, HOUR( 0) },
+ { "a", tZONE, -HOUR( 1) + HOUR(100) },
+ { "b", tZONE, -HOUR( 2) + HOUR(100) },
+ { "c", tZONE, -HOUR( 3) + HOUR(100) },
+ { "d", tZONE, -HOUR( 4) + HOUR(100) },
+ { "e", tZONE, -HOUR( 5) + HOUR(100) },
+ { "f", tZONE, -HOUR( 6) + HOUR(100) },
+ { "g", tZONE, -HOUR( 7) + HOUR(100) },
+ { "h", tZONE, -HOUR( 8) + HOUR(100) },
+ { "i", tZONE, -HOUR( 9) + HOUR(100) },
+ { "k", tZONE, -HOUR(10) + HOUR(100) },
+ { "l", tZONE, -HOUR(11) + HOUR(100) },
+ { "m", tZONE, -HOUR(12) + HOUR(100) },
+ { "n", tZONE, HOUR( 1) + HOUR(100) },
+ { "o", tZONE, HOUR( 2) + HOUR(100) },
+ { "p", tZONE, HOUR( 3) + HOUR(100) },
+ { "q", tZONE, HOUR( 4) + HOUR(100) },
+ { "r", tZONE, HOUR( 5) + HOUR(100) },
+ { "s", tZONE, HOUR( 6) + HOUR(100) },
+ { "t", tZONE, HOUR( 7) + HOUR(100) },
+ { "u", tZONE, HOUR( 8) + HOUR(100) },
+ { "v", tZONE, HOUR( 9) + HOUR(100) },
+ { "w", tZONE, HOUR( 10) + HOUR(100) },
+ { "x", tZONE, HOUR( 11) + HOUR(100) },
+ { "y", tZONE, HOUR( 12) + HOUR(100) },
+ { "z", tZONE, HOUR( 0) + HOUR(100) },
{ NULL, 0, 0 }
};
@@ -2501,12 +2501,12 @@ TclDateerror(
Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
Tcl_AppendToObj(infoPtr->messages, s, -1);
Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
- t = Tcl_NewIntObj(location->first_column);
+ TclNewIntObj(t, location->first_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, "-", -1);
- t = Tcl_NewIntObj(location->last_column);
+ TclNewIntObj(t, location->last_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
@@ -2744,7 +2744,7 @@ TclDatelex(
int
TclClockOldscanObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Count of paraneters */
Tcl_Obj *const *objv) /* Parameters */
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 99992c9..57c1ca7 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -300,13 +300,13 @@ EXTERN int Tcl_ConvertElement(const char *src, char *dst,
EXTERN int Tcl_ConvertCountedElement(const char *src,
int length, char *dst, int flags);
/* 86 */
-EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
- const char *slaveCmd, Tcl_Interp *target,
+EXTERN int Tcl_CreateAlias(Tcl_Interp *childInterp,
+ const char *childCmd, Tcl_Interp *target,
const char *targetCmd, int argc,
const char *const *argv);
/* 87 */
-EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
- const char *slaveCmd, Tcl_Interp *target,
+EXTERN int Tcl_CreateAliasObj(Tcl_Interp *childInterp,
+ const char *childCmd, Tcl_Interp *target,
const char *targetCmd, int objc,
Tcl_Obj *const objv[]);
/* 88 */
@@ -345,8 +345,8 @@ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
/* 97 */
-EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp,
- const char *slaveName, int isSafe);
+EXTERN Tcl_Interp * Tcl_CreateChild(Tcl_Interp *interp, const char *name,
+ int isSafe);
/* 98 */
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
Tcl_TimerProc *proc, ClientData clientData);
@@ -482,13 +482,13 @@ TCL_DEPRECATED("see TIP #559. Use Tcl_ResetResult")
void Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
- const char *slaveCmd,
+ const char *childCmd,
Tcl_Interp **targetInterpPtr,
const char **targetCmdPtr, int *argcPtr,
const char ***argvPtr);
/* 149 */
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
- const char *slaveCmd,
+ const char *childCmd,
Tcl_Interp **targetInterpPtr,
const char **targetCmdPtr, int *objcPtr,
Tcl_Obj ***objv);
@@ -527,10 +527,10 @@ EXTERN int Tcl_GetErrno(void);
/* 162 */
EXTERN const char * Tcl_GetHostName(void);
/* 163 */
-EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp,
- Tcl_Interp *slaveInterp);
+EXTERN int Tcl_GetInterpPath(Tcl_Interp *interp,
+ Tcl_Interp *childInterp);
/* 164 */
-EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
+EXTERN Tcl_Interp * Tcl_GetParent(Tcl_Interp *interp);
/* 165 */
EXTERN const char * Tcl_GetNameOfExecutable(void);
/* 166 */
@@ -556,8 +556,7 @@ EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
EXTERN int Tcl_GetServiceMode(void);
/* 172 */
-EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
- const char *slaveName);
+EXTERN Tcl_Interp * Tcl_GetChild(Tcl_Interp *interp, const char *name);
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
@@ -2037,8 +2036,8 @@ typedef struct TclStubs {
char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
- int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
- int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
+ int (*tcl_CreateAlias) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
+ int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
@@ -2048,7 +2047,7 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
- Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
+ Tcl_Interp * (*tcl_CreateChild) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
@@ -2099,8 +2098,8 @@ typedef struct TclStubs {
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
- int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
- int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
+ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
+ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
@@ -2114,8 +2113,8 @@ typedef struct TclStubs {
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
const char * (*tcl_GetHostName) (void); /* 162 */
- int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
- Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
+ int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */
+ Tcl_Interp * (*tcl_GetParent) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
@@ -2131,7 +2130,7 @@ typedef struct TclStubs {
int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
int (*tcl_GetServiceMode) (void); /* 171 */
- Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
+ Tcl_Interp * (*tcl_GetChild) (Tcl_Interp *interp, const char *name); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
@@ -2829,8 +2828,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
#define Tcl_CreateObjCommand \
(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
-#define Tcl_CreateSlave \
- (tclStubsPtr->tcl_CreateSlave) /* 97 */
+#define Tcl_CreateChild \
+ (tclStubsPtr->tcl_CreateChild) /* 97 */
#define Tcl_CreateTimerHandler \
(tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
#define Tcl_CreateTrace \
@@ -2963,8 +2962,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetHostName) /* 162 */
#define Tcl_GetInterpPath \
(tclStubsPtr->tcl_GetInterpPath) /* 163 */
-#define Tcl_GetMaster \
- (tclStubsPtr->tcl_GetMaster) /* 164 */
+#define Tcl_GetParent \
+ (tclStubsPtr->tcl_GetParent) /* 164 */
#define Tcl_GetNameOfExecutable \
(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#define Tcl_GetObjResult \
@@ -2985,8 +2984,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetsObj) /* 170 */
#define Tcl_GetServiceMode \
(tclStubsPtr->tcl_GetServiceMode) /* 171 */
-#define Tcl_GetSlave \
- (tclStubsPtr->tcl_GetSlave) /* 172 */
+#define Tcl_GetChild \
+ (tclStubsPtr->tcl_GetChild) /* 172 */
#define Tcl_GetStdChannel \
(tclStubsPtr->tcl_GetStdChannel) /* 173 */
#define Tcl_GetStringResult \
@@ -4187,7 +4186,10 @@ extern const TclStubs *tclStubsPtr;
#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX > 3)
# undef Tcl_UtfCharComplete
# define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
- ? 4 : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
+ ? ((length) >= 4) : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
#endif
+#define Tcl_CreateSlave Tcl_CreateChild
+#define Tcl_GetSlave Tcl_GetChild
+#define Tcl_GetMaster Tcl_GetParent
#endif /* _TCLDECLS */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 4789b7f..3efbb74 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -116,7 +116,7 @@ typedef struct {
* entry in this array is 1, otherwise it is
* 0. */
int numSubTables; /* Length of following array. */
- EscapeSubTable subTables[1];/* Information about each EscapeSubTable used
+ EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used
* by this encoding type. The actual size is
* as large as necessary to hold all
* EscapeSubTables. */
@@ -2053,7 +2053,7 @@ LoadEscapeEncoding(
Tcl_DStringFree(&lineString);
}
- size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
+ size = offsetof(EscapeEncodingData, subTables)
+ Tcl_DStringLength(&escapeData);
dataPtr = (EscapeEncodingData *)ckalloc(size);
dataPtr->initLen = strlen(init);
@@ -2300,7 +2300,7 @@ UtfToUtfProc(
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
int result, numChars, charLimit = INT_MAX;
- Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
+ int *chPtr = (int *) statePtr;
if (flags & TCL_ENCODING_START) {
*statePtr = 0;
@@ -2321,7 +2321,7 @@ UtfToUtfProc(
dstEnd = dst + dstLen - TCL_UTF_MAX;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
- if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ if ((src > srcClose) && (!TclUCS4Complete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
* last UTF-8 character in the source buffer hasn't been cut off.
@@ -2341,6 +2341,7 @@ UtfToUtfProc(
*/
*dst++ = *src++;
+ *chPtr = 0; /* reset surrogate handling */
} else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
/*
@@ -2348,24 +2349,25 @@ UtfToUtfProc(
*/
*dst++ = 0;
+ *chPtr = 0; /* reset surrogate handling */
src += 2;
- } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
+ } else if (!TclUCS4Complete(src, srcEnd - src)) {
/*
- * Always check before using TclUtfToUniChar. Not doing can so
+ * 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.
*/
- *chPtr = (unsigned char) *src;
+ *chPtr = UCHAR(*src);
src += 1;
dst += Tcl_UniCharToUtf(*chPtr, dst);
} else {
- src += TclUtfToUniChar(src, chPtr);
+ src += TclUtfToUCS4(src, chPtr);
if ((*chPtr | 0x7FF) == 0xDFFF) {
/* A surrogate character is detected, handle especially */
- Tcl_UniChar low = *chPtr;
- size_t len = (src <= srcEnd-3) ? Tcl_UtfToUniChar(src, &low) : 0;
- if (((low | 0x3FF) != 0xDFFF) || (*chPtr & 0x400)) {
+ int low = *chPtr;
+ size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
+ if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
*dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
*dst++ = (char) ((*chPtr | 0x80) & 0xBF);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index b9c71a0..16bf8f7 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2906,6 +2906,7 @@ TclCompileEnsemble(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation;
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
@@ -2915,7 +2916,6 @@ TclCompileEnsemble(
int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
- DefineLineInformation;
Tcl_IncrRefCount(replaced);
if (parsePtr->numWords < depth + 1) {
@@ -3161,7 +3161,7 @@ TclCompileEnsemble(
}
/*
- * Now we've done the mapping process, can now actually try to compile.
+ * Now that the mapping process is done we actually try to compile.
* If there is a subcommand compiler and that successfully produces code,
* we'll use that. Otherwise, we fall back to generating opcodes to do the
* invoke at runtime.
@@ -3244,6 +3244,7 @@ TclAttemptCompileProc(
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation;
int result, i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
int savedStackDepth = envPtr->currStackDepth;
@@ -3253,7 +3254,6 @@ TclAttemptCompileProc(
#ifdef TCL_COMPILE_DEBUG
int savedExceptDepth = envPtr->exceptDepth;
#endif
- DefineLineInformation;
if (cmdPtr->compileProc == NULL) {
return TCL_ERROR;
@@ -3261,9 +3261,9 @@ TclAttemptCompileProc(
/*
* Advance parsePtr->tokenPtr so that it points at the last subcommand.
- * This will be wrong, but it will not matter, and it will put the
- * tokens for the arguments in the right place without the needed to
- * allocate a synthetic Tcl_Parse struct, or copy tokens around.
+ * This will be wrong but it will not matter, and it will put the
+ * tokens for the arguments in the right place without the need to
+ * allocate a synthetic Tcl_Parse struct or copy tokens around.
*/
for (i = 0; i < depth - 1; i++) {
@@ -3377,11 +3377,11 @@ CompileToInvokedCommand(
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation;
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
const char *bytes;
int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
- DefineLineInformation;
/*
* Push the words of the command. Take care; the command words may be
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index bc4f675..96d050d 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -127,6 +127,17 @@ TclSetupEnv(
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
TclFindArrayPtrElements(varPtr, &namesHash);
+#if defined(_WIN32)
+ if (tenviron == NULL) {
+ /*
+ * When we are started from main(), the _wenviron array could
+ * be NULL and will be initialized by the first _wgetenv() call.
+ */
+
+ (void) _wgetenv(L"WINDIR");
+ }
+#endif
+
/*
* Go through the environment array and transfer its values into Tcl. At
* the same time, remove those elements we add/update from the hash table
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index db1f59a..a6d2234 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -311,7 +311,7 @@ HandleBgErrors(
int
TclDefaultBgErrorHandlerObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1046,7 +1046,7 @@ Tcl_InitSubsystems(void)
* implementation of self-initializing locks.
*/
- TclInitThreadStorage(); /* Creates master hash table for
+ TclInitThreadStorage(); /* Creates hash table for
* thread local storage */
#if USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
@@ -1163,7 +1163,7 @@ Tcl_Finalize(void)
TclFinalizeFilesystem();
/*
- * Undo all Tcl_ObjType registrations, and reset the master list of free
+ * Undo all Tcl_ObjType registrations, and reset the global list of free
* Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
* freed.
*
@@ -1398,7 +1398,7 @@ TclInThreadExit(void)
int
Tcl_VwaitObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1494,7 +1494,7 @@ VwaitVarProc(
int
Tcl_UpdateObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5708772..09fda64 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -855,8 +855,8 @@ TclCreateExecEnv(
* [sizeof(Tcl_Obj*)] */
{
ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv));
- ExecStack *esPtr = (ExecStack *)ckalloc(sizeof(ExecStack)
- + (size_t) (size-1) * sizeof(Tcl_Obj *));
+ ExecStack *esPtr = (ExecStack *)ckalloc(offsetof(ExecStack, stackWords)
+ + size * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
TclNewIntObj(eePtr->constants[0], 0);
@@ -1121,7 +1121,7 @@ GrowEvaluationStack(
newElems = needed;
#endif
- newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
+ newBytes = offsetof(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);
oldPtr = esPtr;
esPtr = (ExecStack *)ckalloc(newBytes);
@@ -2130,6 +2130,22 @@ TEBCresume(
if (!pc) {
/* bytecode is starting from scratch */
pc = codePtr->codeStart;
+
+ /*
+ * Reset the interp's result to avoid possible duplications of large
+ * objects [3c6e47363e], [781585], [804681], This can happen by start
+ * also in nested compiled blocks (enclosed in parent cycle).
+ * See else branch below for opposite handling by continuation/resume.
+ */
+
+ objPtr = iPtr->objResultPtr;
+ if (objPtr->refCount > 1) {
+ TclDecrRefCount(objPtr);
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+ }
+
goto cleanup0;
} else {
/* resume from invocation */
@@ -2169,7 +2185,7 @@ TEBCresume(
objc, cmdNameBuf), Tcl_GetObjResult(interp));
/*
- * Reset the interp's result to avoid possible duplications of large
+ * Obtain and reset interp's result to avoid possible duplications of
* objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
* side effects caused by the resetting of errorInfo and errorCode
* [Bug 804681], which are not needed here. We chose instead to
@@ -3619,7 +3635,7 @@ TEBCresume(
case INST_INCR_SCALAR_STK_IMM:
case INST_INCR_STK_IMM:
increment = TclGetInt1AtPtr(pc+1);
- incrPtr = Tcl_NewIntObj(increment);
+ TclNewIntObj(incrPtr, increment);
Tcl_IncrRefCount(incrPtr);
pcAdjustment = 2;
@@ -3654,7 +3670,7 @@ TEBCresume(
case INST_INCR_ARRAY1_IMM:
opnd = TclGetUInt1AtPtr(pc+1);
increment = TclGetInt1AtPtr(pc+2);
- incrPtr = Tcl_NewIntObj(increment);
+ TclNewIntObj(incrPtr, increment);
Tcl_IncrRefCount(incrPtr);
pcAdjustment = 3;
@@ -4448,7 +4464,7 @@ TEBCresume(
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
TclNewObj(objResultPtr);
- if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+ if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
objResultPtr);
}
@@ -4508,6 +4524,18 @@ TEBCresume(
TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
if (cmd == NULL) {
+ goto instOriginError;
+ }
+ origCmd = TclGetOriginalCommand(cmd);
+ if (origCmd == NULL) {
+ origCmd = cmd;
+ }
+
+ TclNewObj(objResultPtr);
+ Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
+ if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) {
+ Tcl_DecrRefCount(objResultPtr);
+ instOriginError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
DECACHE_STACK_INFO();
@@ -4517,12 +4545,6 @@ TEBCresume(
TRACE_APPEND(("ERROR: not command\n"));
goto gotError;
}
- origCmd = TclGetOriginalCommand(cmd);
- if (origCmd == NULL) {
- origCmd = cmd;
- }
- TclNewObj(objResultPtr);
- Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
NEXT_INST_F(1, 1, 1);
}
@@ -4841,13 +4863,19 @@ TEBCresume(
*/
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
- && !TclHasIntRep(value2Ptr, &tclListType)
- && (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
- &index) == TCL_OK)) {
- TclDecrRefCount(value2Ptr);
- tosPtr--;
- pcAdjustment = 1;
- goto lindexFastPath;
+ && !TclHasIntRep(value2Ptr, &tclListType)) {
+ int code;
+
+ DECACHE_STACK_INFO();
+ code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
+ CACHE_STACK_INFO();
+ if (code == TCL_OK) {
+ TclDecrRefCount(value2Ptr);
+ tosPtr--;
+ pcAdjustment = 1;
+ goto lindexFastPath;
+ }
+ Tcl_ResetResult(interp);
}
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
@@ -5282,10 +5310,13 @@ TEBCresume(
*/
length = Tcl_GetCharLength(valuePtr);
+ DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
+ CACHE_STACK_INFO();
if ((index < 0) || (index >= length)) {
TclNewObj(objResultPtr);
@@ -5322,13 +5353,21 @@ TEBCresume(
TRACE(("\"%.20s\" %.20s %.20s =>",
O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
+
+ DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
- &fromIdx) != TCL_OK
- || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+ &fromIdx) != TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
&toIdx) != TCL_OK) {
+ CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
+ CACHE_STACK_INFO();
if (fromIdx < 0) {
fromIdx = 0;
@@ -5411,14 +5450,17 @@ TEBCresume(
endIdx = Tcl_GetCharLength(valuePtr) - 1;
TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
+ DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
&fromIdx) != TCL_OK
|| TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
&toIdx) != TCL_OK) {
+ CACHE_STACK_INFO();
TclDecrRefCount(value3Ptr);
TRACE_ERROR(interp);
goto gotError;
}
+ CACHE_STACK_INFO();
TclDecrRefCount(OBJ_AT_TOS);
(void) POP_OBJECT();
TclDecrRefCount(OBJ_AT_TOS);
@@ -5543,9 +5585,11 @@ TEBCresume(
ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
match = 1;
if (length > 0) {
+ int ch;
end = ustring1 + length;
- for (p=ustring1 ; p<end ; p++) {
- if (!tclStringClassTable[opnd].comparator(*p)) {
+ for (p=ustring1 ; p<end ; ) {
+ p += TclUniCharToUCS4(p, &ch);
+ if (!tclStringClassTable[opnd].comparator(ch)) {
match = 0;
break;
}
@@ -7004,7 +7048,7 @@ TEBCresume(
if (valuePtr == NULL) {
Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
} else {
- value2Ptr = Tcl_NewIntObj(opnd);
+ TclNewIntObj(value2Ptr, opnd);
Tcl_IncrRefCount(value2Ptr);
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 3babd43..d6a152a 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1085,7 +1085,7 @@ TclFileAttrsCmd(
}
if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
- "option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
+ "option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
@@ -1110,7 +1110,7 @@ TclFileAttrsCmd(
for (i = 0; i < objc ; i += 2) {
if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
- "option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
+ "option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
if (i + 1 == objc) {
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 32b217f..187003d 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -598,7 +598,7 @@ Tcl_SplitPath(
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
str = TclGetStringFromObj(eltPtr, &len);
- memcpy(p, str, len+1);
+ memcpy(p, str, len + 1);
p += len+1;
}
@@ -2055,7 +2055,7 @@ TclGlob(
* SkipToChar --
*
* This function traverses a glob pattern looking for the next unquoted
- * occurance of the specified character at the same braces nesting level.
+ * occurrence of the specified character at the same braces nesting level.
*
* Results:
* Updates stringPtr to point to the matching character, or to the end of
@@ -2445,7 +2445,7 @@ DoGlob(
int len;
const char *joined = TclGetStringFromObj(joinedPtr,&len);
- if (strchr(separators, joined[len-1]) == NULL) {
+ if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
Tcl_AppendToObj(joinedPtr, "/", 1);
}
}
@@ -2482,7 +2482,7 @@ DoGlob(
int len;
const char *joined = TclGetStringFromObj(joinedPtr,&len);
- if (strchr(separators, joined[len-1]) == NULL) {
+ if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
Tcl_AppendToObj(joinedPtr, "/", 1);
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index faa8b69..33b23ae 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -16,7 +16,7 @@
%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
-%pure-parser
+%define api.pure
/* %error-verbose would be nice, but our token names are meaningless */
%locations
@@ -266,43 +266,32 @@ time : tUNUMBER tMERIDIAN {
yySeconds = 0;
yyMeridian = $4;
}
- | tUNUMBER ':' tUNUMBER '-' tUNUMBER {
- yyHour = $1;
- yyMinutes = $3;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ($5 % 100 + ($5 / 100) * 60);
- ++yyHaveZone;
- }
| tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
yyHour = $1;
yyMinutes = $3;
yySeconds = $5;
yyMeridian = $6;
}
- | tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
- yyHour = $1;
- yyMinutes = $3;
- yySeconds = $5;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ($7 % 100 + ($7 / 100) * 60);
- ++yyHaveZone;
- }
;
zone : tZONE tDST {
yyTimezone = $1;
+ if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
yyDSTmode = DSTon;
}
| tZONE {
yyTimezone = $1;
+ if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
yyDSTmode = DSToff;
}
| tDAYZONE {
yyTimezone = $1;
yyDSTmode = DSTon;
}
+ | sign tUNUMBER {
+ yyTimezone = -$1*($2 % 100 + ($2 / 100) * 60);
+ yyDSTmode = DSToff;
+ }
;
day : tDAY {
@@ -386,8 +375,18 @@ ordMonth: tNEXT tMONTH {
}
;
-iso : tISOBASE tZONE tISOBASE {
- if ($2 != HOUR( 7)) YYABORT;
+iso : tUNUMBER '-' tUNUMBER '-' tUNUMBER tZONE
+ tUNUMBER ':' tUNUMBER ':' tUNUMBER {
+ if ($6 != HOUR( 7) + HOUR(100)) YYABORT;
+ yyYear = $1;
+ yyMonth = $3;
+ yyDay = $5;
+ yyHour = $7;
+ yyMinutes = $9;
+ yySeconds = $11;
+ }
+ | tISOBASE tZONE tISOBASE {
+ if ($2 != HOUR( 7) + HOUR(100)) YYABORT;
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
@@ -396,7 +395,7 @@ iso : tISOBASE tZONE tISOBASE {
yySeconds = $3 % 100;
}
| tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
- if ($2 != HOUR( 7)) YYABORT;
+ if ($2 != HOUR( 7) + HOUR(100)) YYABORT;
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
@@ -675,31 +674,31 @@ static const TABLE TimezoneTable[] = {
*/
static const TABLE MilitaryTable[] = {
- { "a", tZONE, -HOUR( 1) },
- { "b", tZONE, -HOUR( 2) },
- { "c", tZONE, -HOUR( 3) },
- { "d", tZONE, -HOUR( 4) },
- { "e", tZONE, -HOUR( 5) },
- { "f", tZONE, -HOUR( 6) },
- { "g", tZONE, -HOUR( 7) },
- { "h", tZONE, -HOUR( 8) },
- { "i", tZONE, -HOUR( 9) },
- { "k", tZONE, -HOUR(10) },
- { "l", tZONE, -HOUR(11) },
- { "m", tZONE, -HOUR(12) },
- { "n", tZONE, HOUR( 1) },
- { "o", tZONE, HOUR( 2) },
- { "p", tZONE, HOUR( 3) },
- { "q", tZONE, HOUR( 4) },
- { "r", tZONE, HOUR( 5) },
- { "s", tZONE, HOUR( 6) },
- { "t", tZONE, HOUR( 7) },
- { "u", tZONE, HOUR( 8) },
- { "v", tZONE, HOUR( 9) },
- { "w", tZONE, HOUR( 10) },
- { "x", tZONE, HOUR( 11) },
- { "y", tZONE, HOUR( 12) },
- { "z", tZONE, HOUR( 0) },
+ { "a", tZONE, -HOUR( 1) + HOUR(100) },
+ { "b", tZONE, -HOUR( 2) + HOUR(100) },
+ { "c", tZONE, -HOUR( 3) + HOUR(100) },
+ { "d", tZONE, -HOUR( 4) + HOUR(100) },
+ { "e", tZONE, -HOUR( 5) + HOUR(100) },
+ { "f", tZONE, -HOUR( 6) + HOUR(100) },
+ { "g", tZONE, -HOUR( 7) + HOUR(100) },
+ { "h", tZONE, -HOUR( 8) + HOUR(100) },
+ { "i", tZONE, -HOUR( 9) + HOUR(100) },
+ { "k", tZONE, -HOUR(10) + HOUR(100) },
+ { "l", tZONE, -HOUR(11) + HOUR(100) },
+ { "m", tZONE, -HOUR(12) + HOUR(100) },
+ { "n", tZONE, HOUR( 1) + HOUR(100) },
+ { "o", tZONE, HOUR( 2) + HOUR(100) },
+ { "p", tZONE, HOUR( 3) + HOUR(100) },
+ { "q", tZONE, HOUR( 4) + HOUR(100) },
+ { "r", tZONE, HOUR( 5) + HOUR(100) },
+ { "s", tZONE, HOUR( 6) + HOUR(100) },
+ { "t", tZONE, HOUR( 7) + HOUR(100) },
+ { "u", tZONE, HOUR( 8) + HOUR(100) },
+ { "v", tZONE, HOUR( 9) + HOUR(100) },
+ { "w", tZONE, HOUR( 10) + HOUR(100) },
+ { "x", tZONE, HOUR( 11) + HOUR(100) },
+ { "y", tZONE, HOUR( 12) + HOUR(100) },
+ { "z", tZONE, HOUR( 0) + HOUR(100) },
{ NULL, 0, 0 }
};
@@ -717,12 +716,12 @@ TclDateerror(
Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
Tcl_AppendToObj(infoPtr->messages, s, -1);
Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
- t = Tcl_NewIntObj(location->first_column);
+ TclNewIntObj(t, location->first_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, "-", -1);
- t = Tcl_NewIntObj(location->last_column);
+ TclNewIntObj(t, location->last_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
@@ -897,7 +896,7 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (TclIsSpaceProc(UCHAR(*yyInput))) {
+ while (TclIsSpaceProcM(*yyInput)) {
yyInput++;
}
@@ -960,7 +959,7 @@ TclDatelex(
int
TclClockOldscanObjCmd(
- void *dummy, /* Unused */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Count of paraneters */
Tcl_Obj *const *objv) /* Parameters */
@@ -970,7 +969,6 @@ TclClockOldscanObjCmd(
DateInfo dateInfo;
DateInfo* info = &dateInfo;
int status;
- (void)dummy;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 63fb997..8c778d4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4756,7 +4756,7 @@ Tcl_GetsObj(
gs.rawRead -= rawRead;
gs.bytesWrote--;
gs.charsWrote--;
- memmove(dst, dst + 1, (size_t) (dstEnd - dst));
+ memmove(dst, dst + 1, dstEnd - dst);
dstEnd--;
}
}
@@ -7711,7 +7711,7 @@ Tcl_BadChannelOption(
}
Tcl_ResetResult(interp);
errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
- optionName);
+ optionName ? optionName : "");
argc--;
for (i = 0; i < argc; i++) {
Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
@@ -10509,7 +10509,7 @@ Tcl_IsChannelExisting(
}
if ((*chanName == *name) &&
- (memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
+ (memcmp(name, chanName, chanNameLen + 1) == 0)) {
return 1;
}
}
diff --git a/generic/tclIO.h b/generic/tclIO.h
index d10f268..54aa5af 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -44,7 +44,7 @@ typedef struct ChannelBuffer {
int bufLength; /* How big is the buffer? */
struct ChannelBuffer *nextPtr;
/* Next buffer in chain. */
- char buf[1]; /* Placeholder for real buffer. The real
+ char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real
* buffer occuppies this space + bufSize-1
* bytes. This must be the last field in the
* structure. */
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 8a5675a..c622afa 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1365,7 +1365,7 @@ ReflectInput(
Tcl_Preserve(rcPtr);
- toReadObj = Tcl_NewIntObj(toRead);
+ TclNewIntObj(toReadObj, toRead);
Tcl_IncrRefCount(toReadObj);
if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
@@ -3047,8 +3047,10 @@ ForwardProc(
}
case ForwardedInput: {
- Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
- Tcl_IncrRefCount(toReadObj);
+ Tcl_Obj *toReadObj;
+
+ TclNewIntObj(toReadObj, paramPtr->input.toRead);
+ Tcl_IncrRefCount(toReadObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index db533d7..acc9e40 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -2697,7 +2697,7 @@ Tcl_FSGetCwd(
* always be in the 'else' branch below which is simpler.
*/
- ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
+ void *cd = (void *) Tcl_FSGetNativePath(norm);
FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
Tcl_DecrRefCount(norm);
@@ -4085,7 +4085,7 @@ TclFSNonnativePathType(
if (pathLen < len) {
continue;
}
- if (strncmp(strVol, path, (size_t) len) == 0) {
+ if (strncmp(strVol, path, len) == 0) {
type = TCL_PATH_ABSOLUTE;
if (filesystemPtrPtr != NULL) {
*filesystemPtrPtr = fsRecPtr->fsPtr;
@@ -4488,7 +4488,7 @@ Tcl_FSGetFileSystemForPath(
return NULL;
}
- /* Start with an up-to-date copy of the master filesystem. */
+ /* Start with an up-to-date copy of the filesystem. */
fsRecPtr = FsGetFirstFilesystem();
Claim();
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 5aa4d42..a0a31da 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -114,7 +114,7 @@ Tcl_GetIndexFromObj(
int flags, /* 0 or TCL_EXACT */
int *indexPtr) /* Place to store resulting integer index. */
{
- if (!(flags & INDEX_TEMP_TABLE)) {
+ if (!(flags & TCL_INDEX_TEMP_TABLE)) {
/*
* See if there is a valid cached result from a previous lookup (doing the
@@ -216,7 +216,7 @@ GetIndexFromObjList(
tablePtr[objc] = NULL;
result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
- sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr);
+ sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr);
ckfree(tablePtr);
@@ -280,7 +280,7 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
- if (!(flags & INDEX_TEMP_TABLE)) {
+ if (!(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchIntRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
@@ -344,7 +344,7 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
- if (!(flags & INDEX_TEMP_TABLE)) {
+ if (!(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchIntRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
@@ -785,7 +785,7 @@ PrefixLongestObjCmd(
* Adjust in case we stopped in the middle of a UTF char.
*/
- resultLength = Tcl_UtfPrev(&resultString[i+1],
+ resultLength = TclUtfPrev(&resultString[i+1],
resultString) - resultString;
break;
}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index bdc7288..4599bce 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -893,7 +893,7 @@ declare 227 {
# Used to be needed for TclOO-extension; unneeded now that TclOO is in the
# core and NRE-enabled
# declare 228 {
-# int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
+# int TclObjInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
# int skip, ProcErrorProc *errorProc)
# }
declare 229 {
@@ -990,7 +990,7 @@ declare 249 {
}
# TIP #285: Script cancellation support.
declare 250 {
- void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
+ void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force)
}
# Allow extensions for optimization
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2ff644e..a5e8122 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -925,6 +925,12 @@ typedef struct VarInHash {
*----------------------------------------------------------------
*/
+#if defined(__GNUC__) && (__GNUC__ > 2)
+# define TCLFLEXARRAY 0
+#else
+# define TCLFLEXARRAY 1
+#endif
+
/*
* Forward declaration to prevent an error when the forward reference to
* Command is encountered in the Proc and ImportRef types declared below.
@@ -968,7 +974,7 @@ typedef struct CompiledLocal {
* is marked by a unique tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
- char name[1]; /* Name of the local variable starts here. If
+ char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
* the name is NULL, this will just be '\0'.
* The actual size of this field will be large
* enough to hold the name. MUST BE THE LAST
@@ -1306,7 +1312,7 @@ typedef struct CFWordBC {
typedef struct ContLineLoc {
int num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
- int loc[1]; /* Table of locations, as character offsets.
+ int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
* The table is allocated as part of the
* structure, extending behind the nominal end
* of the structure. An entry containing the
@@ -1455,7 +1461,7 @@ typedef struct ExecStack {
Tcl_Obj **markerPtr;
Tcl_Obj **endPtr;
Tcl_Obj **tosPtr;
- Tcl_Obj *stackWords[1];
+ Tcl_Obj *stackWords[TCLFLEXARRAY];
} ExecStack;
/*
@@ -1707,18 +1713,18 @@ typedef struct Command {
/*
* Flag bits for commands.
*
- * CMD_IS_DELETED - Means that the command is in the process of
+ * CMD_DYING - If 1 the command is in the process of
* being deleted (its deleteProc is currently
* executing). Other attempts to delete the
* command should be ignored.
- * CMD_TRACE_ACTIVE - 1 means that trace processing is currently
+ * CMD_TRACE_ACTIVE - If 1 the trace processing is currently
* underway for a rename/delete change. See the
* two flags below for which is currently being
* processed.
- * CMD_HAS_EXEC_TRACES - 1 means that this command has at least one
+ * CMD_HAS_EXEC_TRACES - If 1 means that this command has at least one
* execution trace (as opposed to simple
* delete/rename traces) in its tracePtr list.
- * CMD_COMPILES_EXPANDED - 1 means that this command has a compiler that
+ * CMD_COMPILES_EXPANDED - If 1 this command has a compiler that
* can handle expansion (provided it is not the
* first word).
* TCL_TRACE_RENAME - A rename trace is in progress. Further
@@ -1728,12 +1734,13 @@ typedef struct Command {
* (these last two flags are defined in tcl.h)
*/
-#define CMD_IS_DELETED 0x01
+#define CMD_DYING 0x01
#define CMD_TRACE_ACTIVE 0x02
#define CMD_HAS_EXEC_TRACES 0x04
#define CMD_COMPILES_EXPANDED 0x08
#define CMD_REDEF_IN_PROGRESS 0x10
#define CMD_VIA_RESOLVER 0x20
+#define CMD_DEAD 0x40
/*
@@ -1856,7 +1863,7 @@ typedef struct Interp {
* of hidden commands on a per-interp
* basis. */
void *interpInfo; /* Information used by tclInterp.c to keep
- * track of master/slave interps on a
+ * track of parent/child interps on a
* per-interp basis. */
union {
void (*optimizer)(void *envPtr);
@@ -2146,7 +2153,7 @@ typedef struct Interp {
* (c) are accessed very often (e.g., at each command call)
*
* Note that these are the same for all interps in the same thread. They
- * just have to be initialised for the thread's master interp, slaves
+ * just have to be initialised for the thread's parent interp, children
* inherit the value.
*
* They are used by the macros defined below.
@@ -2522,10 +2529,9 @@ typedef struct List {
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
- (((objPtr)->typePtr == &tclIntType \
- && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
- ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \
- ? (int)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \
+ ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
+ && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \
+ ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
/*
@@ -2606,15 +2612,6 @@ typedef struct TclFileAttrProcs {
} TclFileAttrProcs;
/*
- * Private flag value which controls Tcl_GetIndexFromObj*() routines
- * to instruct them not to cache lookups because the table will not
- * live long enough to make it worthwhile. Must not clash with public
- * flag value TCL_EXACT.
- */
-
-#define INDEX_TEMP_TABLE 2
-
-/*
* Opaque handle used in pipeline routines to encapsulate platform-dependent
* state.
*/
@@ -2670,20 +2667,20 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng
/*
* A ProcessGlobalValue struct exists for each internal value in Tcl that is
* to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
- * the value, and the master is kept as a counted string, with epoch and mutex
- * control. Each ProcessGlobalValue struct should be a static variable in some
- * file.
+ * the value, and the gobal value is kept as a counted string, with epoch and
+ * mutex control. Each ProcessGlobalValue struct should be a static variable in
+ * some file.
*/
typedef struct ProcessGlobalValue {
unsigned int epoch; /* Epoch counter to detect changes in the
- * master value. */
- unsigned int numBytes; /* Length of the master string. */
- char *value; /* The master string value. */
- Tcl_Encoding encoding; /* system encoding when master string was
+ * global value. */
+ unsigned int numBytes; /* Length of the global string. */
+ char *value; /* The global string value. */
+ Tcl_Encoding encoding; /* system encoding when global string was
* initialized. */
TclInitProcessGlobalValueProc *proc;
- /* A procedure to initialize the master string
+ /* A procedure to initialize the global string
* copy when a "get" request comes in before
* any "set" request has been received. */
Tcl_Mutex mutex; /* Enforce orderly access from multiple
@@ -2714,6 +2711,8 @@ typedef struct ProcessGlobalValue {
/* Reject leading/trailing whitespace. */
#define TCL_PARSE_BINARY_ONLY 64
/* Parse binary even without prefix. */
+#define TCL_PARSE_NO_UNDERSCORE 128
+ /* Reject underscore digit separator */
/*
*----------------------------------------------------------------------
@@ -3156,8 +3155,8 @@ MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
-MODULE_SCOPE void TclpMasterLock(void);
-MODULE_SCOPE void TclpMasterUnlock(void);
+MODULE_SCOPE void TclpGlobalLock(void);
+MODULE_SCOPE void TclpGlobalUnlock(void);
MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators,
Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp,
@@ -3252,8 +3251,16 @@ MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCount(int ch);
#if TCL_UTF_MAX > 3
# define TclUtfToUCS4 Tcl_UtfToUniChar
+# define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
+# define TclUCS4Complete Tcl_UtfCharComplete
+# define TclChar16Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
+ ? ((length) >= 3) : Tcl_UtfCharComplete((src), (length)))
#else
- MODULE_SCOPE int TclUtfToUCS4(const char *src, int *ucs4Ptr);
+ MODULE_SCOPE int TclUtfToUCS4(const char *src, int *ucs4Ptr);
+ MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *src, int *ucs4Ptr);
+# define TclUCS4Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
+ ? ((length) >= 4) : Tcl_UtfCharComplete((src), (length)))
+# define TclChar16Complete Tcl_UtfCharComplete
#endif
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
@@ -3296,8 +3303,8 @@ MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
-MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
-MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
+MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
const char *msg, int length);
/* Tip 430 */
@@ -4165,7 +4172,7 @@ MODULE_SCOPE int TclFullFinalizationRequested(void);
MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclChildObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
@@ -4655,8 +4662,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
- ((((unsigned char) *(str)) < 0x80) ? \
- ((*(chPtr) = (unsigned char) *(str)), 1) \
+ (((UCHAR(*(str))) < 0x80) ? \
+ ((*(chPtr) = UCHAR(*(str))), 1) \
: Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
@@ -4694,9 +4701,6 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
((unsigned char) *((src) - 1)) < 0x80 ? (src) - 1 : \
Tcl_UtfPrev(src, start))
-#define TclUtfNext(src) \
- ((((unsigned char) *(src)) < 0x80) ? (src) + 1 : Tcl_UtfNext(src))
-
/*
*----------------------------------------------------------------
* Macro that encapsulates the logic that determines when it is safe to
@@ -4928,7 +4932,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* Computes number of bytes from beginning of structure to a given field.
*/
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && !defined(BUILD_tcl)
# define TclOffset(type, field) ((int) offsetof(type, field))
#endif
/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */
@@ -4953,10 +4957,30 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* the internal stubs, but the core can use the macro instead.
*/
-#define TclCleanupCommandMacro(cmdPtr) \
- if ((cmdPtr)->refCount-- <= 1) { \
- ckfree(cmdPtr);\
- }
+#define TclCleanupCommandMacro(cmdPtr) \
+ do { \
+ if ((cmdPtr)->refCount-- <= 1) { \
+ ckfree(cmdPtr); \
+ } \
+ } while (0)
+
+
+/*
+ * inside this routine crement refCount first incase cmdPtr is replacing itself
+ */
+#define TclRoutineAssign(location, cmdPtr) \
+ do { \
+ (cmdPtr)->refCount++; \
+ if ((location) != NULL \
+ && (location--) <= 1) { \
+ ckfree(((location))); \
+ } \
+ (location) = (cmdPtr); \
+ } while (0)
+
+
+#define TclRoutineHasName(cmdPtr) \
+ ((cmdPtr)->hPtr != NULL)
/*
*----------------------------------------------------------------
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 8ba0c4c..2c5b292 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -623,7 +623,7 @@ EXTERN int TclCopyChannel(Tcl_Interp *interp,
EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags,
int *decpt, int *signum, char **endPtr);
/* 250 */
-EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
+EXTERN void TclSetChildCancelFlags(Tcl_Interp *interp, int flags,
int force);
/* 251 */
EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes,
@@ -915,7 +915,7 @@ typedef struct TclIntStubs {
void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
- void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
+ void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
@@ -1352,8 +1352,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCopyChannel) /* 248 */
#define TclDoubleDigits \
(tclIntStubsPtr->tclDoubleDigits) /* 249 */
-#define TclSetSlaveCancelFlags \
- (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclSetChildCancelFlags \
+ (tclIntStubsPtr->tclSetChildCancelFlags) /* 250 */
#define TclRegisterLiteral \
(tclIntStubsPtr->tclRegisterLiteral) /* 251 */
#define TclPtrGetVar \
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1570837..b84c065 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -27,34 +27,34 @@ struct Target;
/*
* struct Alias:
*
- * Stores information about an alias. Is stored in the slave interpreter and
- * used by the source command to find the target command in the master when
+ * Stores information about an alias. Is stored in the child interpreter and
+ * used by the source command to find the target command in the parent when
* the source command is invoked.
*/
typedef struct Alias {
- Tcl_Obj *token; /* Token for the alias command in the slave
+ Tcl_Obj *token; /* Token for the alias command in the child
* interp. This used to be the command name in
- * the slave when the alias was first
+ * the child when the alias was first
* created. */
Tcl_Interp *targetInterp; /* Interp in which target command will be
* invoked. */
- Tcl_Command slaveCmd; /* Source command in slave interpreter, bound
+ Tcl_Command childCmd; /* Source command in child interpreter, bound
* to command that invokes the target command
* in the target interpreter. */
Tcl_HashEntry *aliasEntryPtr;
- /* Entry for the alias hash table in slave.
+ /* Entry for the alias hash table in child.
* This is used by alias deletion to remove
- * the alias from the slave interpreter alias
+ * the alias from the child interpreter alias
* table. */
- struct Target *targetPtr; /* Entry for target command in master. This is
- * used in the master interpreter to map back
+ struct Target *targetPtr; /* Entry for target command in parent. This is
+ * used in the parent interpreter to map back
* from the target command to aliases
* redirecting to it. */
int objc; /* Count of Tcl_Obj in the prefix of the
* target command to be invoked in the target
* interpreter. Additional arguments specified
- * when calling the alias in the slave interp
+ * when calling the alias in the child interp
* will be appended to the prefix before the
* command is invoked. */
Tcl_Obj *objPtr; /* The first actual prefix object - the target
@@ -66,45 +66,45 @@ typedef struct Alias {
/*
*
- * struct Slave:
+ * struct Child:
*
- * Used by the "interp" command to record and find information about slave
- * interpreters. Maps from a command name in the master to information about a
- * slave interpreter, e.g. what aliases are defined in it.
+ * Used by the "interp" command to record and find information about child
+ * interpreters. Maps from a command name in the parent to information about a
+ * child interpreter, e.g. what aliases are defined in it.
*/
-typedef struct Slave {
- Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
- Tcl_HashEntry *slaveEntryPtr;
- /* Hash entry in masters slave table for this
- * slave interpreter. Used to find this
- * record, and used when deleting the slave
- * interpreter to delete it from the master's
+typedef struct Child {
+ Tcl_Interp *parentInterp; /* Parent interpreter for this child. */
+ Tcl_HashEntry *childEntryPtr;
+ /* Hash entry in parents child table for this
+ * child interpreter. Used to find this
+ * record, and used when deleting the child
+ * interpreter to delete it from the parent's
* table. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
+ Tcl_Interp *childInterp; /* The child interpreter. */
Tcl_Command interpCmd; /* Interpreter object command. */
Tcl_HashTable aliasTable; /* Table which maps from names of commands in
- * slave interpreter to struct Alias defined
+ * child interpreter to struct Alias defined
* below. */
-} Slave;
+} Child;
/*
* struct Target:
*
- * Maps from master interpreter commands back to the source commands in slave
+ * Maps from parent interpreter commands back to the source commands in child
* interpreters. This is needed because aliases can be created between sibling
* interpreters and must be deleted when the target interpreter is deleted. In
* case they would not be deleted the source interpreter would be left with a
- * "dangling pointer". One such record is stored in the Master record of the
- * master interpreter with the master for each alias which directs to a
- * command in the master. These records are used to remove the source command
- * for an from a slave if/when the master is deleted. They are organized in a
- * doubly-linked list attached to the master interpreter.
+ * "dangling pointer". One such record is stored in the Parent record of the
+ * parent interpreter with the parent for each alias which directs to a
+ * command in the parent. These records are used to remove the source command
+ * for an from a child if/when the parent is deleted. They are organized in a
+ * doubly-linked list attached to the parent interpreter.
*/
typedef struct Target {
- Tcl_Command slaveCmd; /* Command for alias in slave interp. */
- Tcl_Interp *slaveInterp; /* Slave Interpreter. */
+ Tcl_Command childCmd; /* Command for alias in child interp. */
+ Tcl_Interp *childInterp; /* Child Interpreter. */
struct Target *nextPtr; /* Next in list of target records, or NULL if
* at the end of the list of targets. */
struct Target *prevPtr; /* Previous in list of target records, or NULL
@@ -112,43 +112,43 @@ typedef struct Target {
} Target;
/*
- * struct Master:
+ * struct Parent:
*
- * This record is used for two purposes: First, slaveTable (a hashtable) maps
- * from names of commands to slave interpreters. This hashtable is used to
- * store information about slave interpreters of this interpreter, to map over
- * all slaves, etc. The second purpose is to store information about all
- * aliases in slaves (or siblings) which direct to target commands in this
+ * This record is used for two purposes: First, childTable (a hashtable) maps
+ * from names of commands to child interpreters. This hashtable is used to
+ * store information about child interpreters of this interpreter, to map over
+ * all children, etc. The second purpose is to store information about all
+ * aliases in children (or siblings) which direct to target commands in this
* interpreter (using the targetsPtr doubly-linked list).
*
* 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 slave interpreters and can
+ * restricted functionality, can only create safe interpreters and can
* only load safe extensions.
*/
-typedef struct Master {
- Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps
- * from command names to Slave records. */
+typedef struct Parent {
+ Tcl_HashTable childTable; /* Hash table for child interpreters. Maps
+ * from command names to Child records. */
Target *targetsPtr; /* The head of a doubly-linked list of all the
* target records which denote aliases from
- * slaves or sibling interpreters that direct
+ * children or sibling interpreters that direct
* to commands in this interpreter. This list
* is used to remove dangling pointers from
- * the slave (or sibling) interpreters when
+ * the child (or sibling) interpreters when
* this interpreter is deleted. */
-} Master;
+} Parent;
/*
- * The following structure keeps track of all the Master and Slave information
+ * The following structure keeps track of all the Parent and Child information
* on a per-interp basis.
*/
typedef struct InterpInfo {
- Master master; /* Keeps track of all interps for which this
- * interp is the Master. */
- Slave slave; /* Information necessary for this interp to
- * function as a slave. */
+ Parent parent; /* Keeps track of all interps for which this
+ * interp is the Parent. */
+ Child child; /* Information necessary for this interp to
+ * function as a child. */
} InterpInfo;
/*
@@ -214,55 +214,55 @@ struct LimitHandler {
*/
static int AliasCreate(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
+ Tcl_Interp *childInterp, Tcl_Interp *parentInterp,
Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
Tcl_Obj *const objv[]);
static int AliasDelete(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
+ Tcl_Interp *childInterp, Tcl_Obj *namePtr);
static int AliasDescribe(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
-static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
+ Tcl_Interp *childInterp, Tcl_Obj *objPtr);
+static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp);
static Tcl_ObjCmdProc AliasNRCmd;
static Tcl_CmdDeleteProc AliasObjCmdDeleteProc;
static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static Tcl_InterpDeleteProc InterpInfoDeleteProc;
-static int SlaveBgerror(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
+static int ChildBgerror(Tcl_Interp *interp,
+ Tcl_Interp *childInterp, int objc,
Tcl_Obj *const objv[]);
-static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+static Tcl_Interp * ChildCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int safe);
-static int SlaveDebugCmd(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp,
+static int ChildDebugCmd(Tcl_Interp *interp,
+ Tcl_Interp *childInterp,
int objc, Tcl_Obj *const objv[]);
-static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+static int ChildEval(Tcl_Interp *interp, Tcl_Interp *childInterp,
int objc, Tcl_Obj *const objv[]);
-static int SlaveExpose(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
+static int ChildExpose(Tcl_Interp *interp,
+ Tcl_Interp *childInterp, int objc,
Tcl_Obj *const objv[]);
-static int SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+static int ChildHide(Tcl_Interp *interp, Tcl_Interp *childInterp,
int objc, Tcl_Obj *const objv[]);
-static int SlaveHidden(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp);
-static int SlaveInvokeHidden(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp,
+static int ChildHidden(Tcl_Interp *interp,
+ Tcl_Interp *childInterp);
+static int ChildInvokeHidden(Tcl_Interp *interp,
+ Tcl_Interp *childInterp,
const char *namespaceName,
int objc, Tcl_Obj *const objv[]);
-static int SlaveMarkTrusted(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp);
-static Tcl_CmdDeleteProc SlaveObjCmdDeleteProc;
-static int SlaveRecursionLimit(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
+static int ChildMarkTrusted(Tcl_Interp *interp,
+ Tcl_Interp *childInterp);
+static Tcl_CmdDeleteProc ChildObjCmdDeleteProc;
+static int ChildRecursionLimit(Tcl_Interp *interp,
+ Tcl_Interp *childInterp, int objc,
Tcl_Obj *const objv[]);
-static int SlaveCommandLimitCmd(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int consumedObjc,
+static int ChildCommandLimitCmd(Tcl_Interp *interp,
+ Tcl_Interp *childInterp, int consumedObjc,
int objc, Tcl_Obj *const objv[]);
-static int SlaveTimeLimitCmd(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int consumedObjc,
+static int ChildTimeLimitCmd(Tcl_Interp *interp,
+ Tcl_Interp *childInterp, int consumedObjc,
int objc, Tcl_Obj *const objv[]);
-static void InheritLimitsFromMaster(Tcl_Interp *slaveInterp,
- Tcl_Interp *masterInterp);
+static void InheritLimitsFromParent(Tcl_Interp *childInterp,
+ Tcl_Interp *parentInterp);
static void SetScriptLimitCallback(Tcl_Interp *interp, int type,
Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
static void CallScriptLimitCallback(ClientData clientData,
@@ -275,7 +275,7 @@ static void TimeLimitCallback(ClientData clientData);
/* NRE enabling */
static Tcl_NRPostProc NRPostInvokeHidden;
static Tcl_ObjCmdProc NRInterpCmd;
-static Tcl_ObjCmdProc NRSlaveCmd;
+static Tcl_ObjCmdProc NRChildCmd;
/*
@@ -461,7 +461,7 @@ end:
*
* TclInterpInit --
*
- * Initializes the invoking interpreter for using the master, slave and
+ * Initializes the invoking interpreter for using the parent, child and
* safe interp facilities. This is called from inside Tcl_CreateInterp().
*
* Results:
@@ -479,22 +479,22 @@ TclInterpInit(
Tcl_Interp *interp) /* Interpreter to initialize. */
{
InterpInfo *interpInfoPtr;
- Master *masterPtr;
- Slave *slavePtr;
+ Parent *parentPtr;
+ Child *childPtr;
interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo));
((Interp *) interp)->interpInfo = interpInfoPtr;
- masterPtr = &interpInfoPtr->master;
- Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
- masterPtr->targetsPtr = NULL;
+ parentPtr = &interpInfoPtr->parent;
+ Tcl_InitHashTable(&parentPtr->childTable, TCL_STRING_KEYS);
+ parentPtr->targetsPtr = NULL;
- slavePtr = &interpInfoPtr->slave;
- slavePtr->masterInterp = NULL;
- slavePtr->slaveEntryPtr = NULL;
- slavePtr->slaveInterp = interp;
- slavePtr->interpCmd = NULL;
- Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
+ childPtr = &interpInfoPtr->child;
+ childPtr->parentInterp = NULL;
+ childPtr->childEntryPtr = NULL;
+ childPtr->childInterp = interp;
+ childPtr->interpCmd = NULL;
+ Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
NULL, NULL);
@@ -509,7 +509,7 @@ TclInterpInit(
* InterpInfoDeleteProc --
*
* Invoked when an interpreter is being deleted. It releases all storage
- * used by the master/slave/safe interpreter facilities.
+ * used by the parent/child/safe interpreter facilities.
*
* Results:
* None.
@@ -522,13 +522,13 @@ TclInterpInit(
static void
InterpInfoDeleteProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp) /* Interp being deleted. All commands for
- * slave interps should already be deleted. */
+ * child interps should already be deleted. */
{
InterpInfo *interpInfoPtr;
- Slave *slavePtr;
- Master *masterPtr;
+ Child *childPtr;
+ Parent *parentPtr;
Target *targetPtr;
interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
@@ -537,11 +537,11 @@ InterpInfoDeleteProc(
* There shouldn't be any commands left.
*/
- masterPtr = &interpInfoPtr->master;
- if (masterPtr->slaveTable.numEntries != 0) {
+ parentPtr = &interpInfoPtr->parent;
+ if (parentPtr->childTable.numEntries != 0) {
Tcl_Panic("InterpInfoDeleteProc: still exist commands");
}
- Tcl_DeleteHashTable(&masterPtr->slaveTable);
+ Tcl_DeleteHashTable(&parentPtr->childTable);
/*
* Tell any interps that have aliases to this interp that they should
@@ -549,35 +549,35 @@ InterpInfoDeleteProc(
* have removed the target record already.
*/
- for (targetPtr = masterPtr->targetsPtr; targetPtr != NULL; ) {
+ for (targetPtr = parentPtr->targetsPtr; targetPtr != NULL; ) {
Target *tmpPtr = targetPtr->nextPtr;
- Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
- targetPtr->slaveCmd);
+ Tcl_DeleteCommandFromToken(targetPtr->childInterp,
+ targetPtr->childCmd);
targetPtr = tmpPtr;
}
- slavePtr = &interpInfoPtr->slave;
- if (slavePtr->interpCmd != NULL) {
+ childPtr = &interpInfoPtr->child;
+ if (childPtr->interpCmd != NULL) {
/*
* Tcl_DeleteInterp() was called on this interpreter, rather "interp
- * delete" or the equivalent deletion of the command in the master.
+ * delete" or the equivalent deletion of the command in the parent.
* First ensure that the cleanup callback doesn't try to delete the
* interp again.
*/
- slavePtr->slaveInterp = NULL;
- Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
- slavePtr->interpCmd);
+ childPtr->childInterp = NULL;
+ Tcl_DeleteCommandFromToken(childPtr->parentInterp,
+ childPtr->interpCmd);
}
/*
* There shouldn't be any aliases left.
*/
- if (slavePtr->aliasTable.numEntries != 0) {
+ if (childPtr->aliasTable.numEntries != 0) {
Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
}
- Tcl_DeleteHashTable(&slavePtr->aliasTable);
+ Tcl_DeleteHashTable(&childPtr->aliasTable);
ckfree(interpInfoPtr);
}
@@ -611,16 +611,16 @@ Tcl_InterpObjCmd(
static int
NRInterpCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Interp *slaveInterp;
+ Tcl_Interp *childInterp;
int index;
static const char *const options[] = {
"alias", "aliases", "bgerror", "cancel",
- "create", "debug", "delete",
+ "children", "create", "debug", "delete",
"eval", "exists", "expose",
"hide", "hidden", "issafe",
"invokehidden", "limit", "marktrusted", "recursionlimit",
@@ -629,7 +629,7 @@ NRInterpCmd(
};
enum option {
OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
- OPT_CREATE, OPT_DEBUG, OPT_DELETE,
+ OPT_CHILDREN, OPT_CREATE, OPT_DEBUG, OPT_DELETE,
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
OPT_INVOKEHID, OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT,
@@ -646,51 +646,51 @@ NRInterpCmd(
}
switch ((enum option) index) {
case OPT_ALIAS: {
- Tcl_Interp *masterInterp;
+ Tcl_Interp *parentInterp;
if (objc < 4) {
aliasArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?");
+ "childPath childCmd ?parentPath parentCmd? ?arg ...?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
if (objc == 4) {
- return AliasDescribe(interp, slaveInterp, objv[3]);
+ return AliasDescribe(interp, childInterp, objv[3]);
}
if ((objc == 5) && (TclGetString(objv[4])[0] == '\0')) {
- return AliasDelete(interp, slaveInterp, objv[3]);
+ return AliasDelete(interp, childInterp, objv[3]);
}
if (objc > 5) {
- masterInterp = GetInterp(interp, objv[4]);
- if (masterInterp == NULL) {
+ parentInterp = GetInterp(interp, objv[4]);
+ if (parentInterp == NULL) {
return TCL_ERROR;
}
- return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
+ return AliasCreate(interp, childInterp, parentInterp, objv[3],
objv[5], objc - 6, objv + 6);
}
goto aliasArgs;
}
case OPT_ALIASES:
- slaveInterp = GetInterp2(interp, objc, objv);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp2(interp, objc, objv);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return AliasList(interp, slaveInterp);
+ return AliasList(interp, childInterp);
case OPT_BGERROR:
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
+ return ChildBgerror(interp, childInterp, objc - 3, objv + 3);
case OPT_CANCEL: {
int i, flags;
Tcl_Obj *resultObjPtr;
@@ -734,18 +734,18 @@ NRInterpCmd(
}
/*
- * Did they specify a slave interp to cancel the script in progress
+ * Did they specify a child interp to cancel the script in progress
* in? If not, use the current interp.
*/
if (i < objc) {
- slaveInterp = GetInterp(interp, objv[i]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[i]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
i++;
} else {
- slaveInterp = interp;
+ childInterp = interp;
}
if (i < objc) {
@@ -761,11 +761,11 @@ NRInterpCmd(
resultObjPtr = NULL;
}
- return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
+ return Tcl_CancelEval(childInterp, resultObjPtr, 0, flags);
}
case OPT_CREATE: {
int i, last, safe;
- Tcl_Obj *slavePtr;
+ Tcl_Obj *childPtr;
char buf[16 + TCL_INTEGER_SPACE];
static const char *const createOptions[] = {
"-safe", "--", NULL
@@ -780,7 +780,7 @@ NRInterpCmd(
* Weird historical rules: "-safe" is accepted at the end, too.
*/
- slavePtr = NULL;
+ childPtr = NULL;
last = 0;
for (i = 2; i < objc; i++) {
if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
@@ -795,21 +795,21 @@ NRInterpCmd(
i++;
last = 1;
}
- if (slavePtr != NULL) {
+ if (childPtr != NULL) {
Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
return TCL_ERROR;
}
if (i < objc) {
- slavePtr = objv[i];
+ childPtr = objv[i];
}
}
buf[0] = '\0';
- if (slavePtr == NULL) {
+ if (childPtr == NULL) {
/*
* Create an anonymous interpreter -- we choose its name and the
* name of the command. We check that the command name that we use
* for the interpreter does not collide with an existing command
- * in the master interpreter.
+ * in the parent interpreter.
*/
for (i = 0; ; i++) {
@@ -820,15 +820,15 @@ NRInterpCmd(
break;
}
}
- slavePtr = Tcl_NewStringObj(buf, -1);
+ childPtr = Tcl_NewStringObj(buf, -1);
}
- if (SlaveCreate(interp, slavePtr, safe) == NULL) {
+ if (ChildCreate(interp, childPtr, safe) == NULL) {
if (buf[0] != '\0') {
- Tcl_DecrRefCount(slavePtr);
+ Tcl_DecrRefCount(childPtr);
}
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, slavePtr);
+ Tcl_SetObjResult(interp, childPtr);
return TCL_OK;
}
case OPT_DEBUG: /* TIP #378 */
@@ -840,29 +840,29 @@ NRInterpCmd(
Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
+ return ChildDebugCmd(interp, childInterp, objc - 3, objv + 3);
case OPT_DELETE: {
int i;
InterpInfo *iiPtr;
for (i = 2; i < objc; i++) {
- slaveInterp = GetInterp(interp, objv[i]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[i]);
+ if (childInterp == NULL) {
return TCL_ERROR;
- } else if (slaveInterp == interp) {
+ } else if (childInterp == interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot delete the current interpreter", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"DELETESELF", NULL);
return TCL_ERROR;
}
- iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
- Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
- iiPtr->slave.interpCmd);
+ iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
+ Tcl_DeleteCommandFromToken(iiPtr->child.parentInterp,
+ iiPtr->child.interpCmd);
}
return TCL_OK;
}
@@ -871,16 +871,16 @@ NRInterpCmd(
Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
+ return ChildEval(interp, childInterp, objc - 3, objv + 3);
case OPT_EXISTS: {
int exists = 1;
- slaveInterp = GetInterp2(interp, objc, objv);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp2(interp, objc, objv);
+ if (childInterp == NULL) {
if (objc > 3) {
return TCL_ERROR;
}
@@ -895,33 +895,33 @@ NRInterpCmd(
Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
+ return ChildExpose(interp, childInterp, objc - 3, objv + 3);
case OPT_HIDE:
if ((objc < 4) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
+ return ChildHide(interp, childInterp, objc - 3, objv + 3);
case OPT_HIDDEN:
- slaveInterp = GetInterp2(interp, objc, objv);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp2(interp, objc, objv);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveHidden(interp, slaveInterp);
+ return ChildHidden(interp, childInterp);
case OPT_ISSAFE:
- slaveInterp = GetInterp2(interp, objc, objv);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp2(interp, objc, objv);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp)));
return TCL_OK;
case OPT_INVOKEHID: {
int i;
@@ -960,11 +960,11 @@ NRInterpCmd(
"path ?-namespace ns? ?-global? ?--? cmd ?arg ..?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i,
+ return ChildInvokeHidden(interp, childInterp, namespaceName, objc - i,
objv + i);
}
case OPT_LIMIT: {
@@ -981,8 +981,8 @@ NRInterpCmd(
"path limitType ?-option value ...?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[3], limitTypes, "limit type", 0,
@@ -991,9 +991,9 @@ NRInterpCmd(
}
switch ((enum LimitTypes) limitType) {
case LIMIT_TYPE_COMMANDS:
- return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv);
+ return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv);
case LIMIT_TYPE_TIME:
- return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
+ return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv);
}
}
break;
@@ -1002,21 +1002,22 @@ NRInterpCmd(
Tcl_WrongNumArgs(interp, 2, objv, "path");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveMarkTrusted(interp, slaveInterp);
+ return ChildMarkTrusted(interp, childInterp);
case OPT_RECLIMIT:
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
+ return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
+ case OPT_CHILDREN:
case OPT_SLAVES: {
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
@@ -1024,15 +1025,15 @@ NRInterpCmd(
Tcl_HashSearch hashSearch;
char *string;
- slaveInterp = GetInterp2(interp, objc, objv);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp2(interp, objc, objv);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+ iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
resultPtr = Tcl_NewObj();
- hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
+ hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
- string = (char *)Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
+ string = (char *)Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr);
Tcl_ListObjAppendElement(NULL, resultPtr,
Tcl_NewStringObj(string, -1));
}
@@ -1041,35 +1042,35 @@ NRInterpCmd(
}
case OPT_TRANSFER:
case OPT_SHARE: {
- Tcl_Interp *masterInterp; /* The master of the slave. */
+ Tcl_Interp *parentInterp; /* The parent of the child. */
Tcl_Channel chan;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
return TCL_ERROR;
}
- masterInterp = GetInterp(interp, objv[2]);
- if (masterInterp == NULL) {
+ parentInterp = GetInterp(interp, objv[2]);
+ if (parentInterp == NULL) {
return TCL_ERROR;
}
- chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
+ chan = Tcl_GetChannel(parentInterp, TclGetString(objv[3]), NULL);
if (chan == NULL) {
- Tcl_TransferResult(masterInterp, TCL_OK, interp);
+ Tcl_TransferResult(parentInterp, TCL_OK, interp);
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[4]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[4]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
- Tcl_RegisterChannel(slaveInterp, chan);
+ Tcl_RegisterChannel(childInterp, chan);
if (index == OPT_TRANSFER) {
/*
* When transferring, as opposed to sharing, we must unhitch the
* channel from the interpreter where it started.
*/
- if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
- Tcl_TransferResult(masterInterp, TCL_OK, interp);
+ if (Tcl_UnregisterChannel(parentInterp, chan) != TCL_OK) {
+ Tcl_TransferResult(parentInterp, TCL_OK, interp);
return TCL_ERROR;
}
}
@@ -1086,15 +1087,15 @@ NRInterpCmd(
return TCL_ERROR;
}
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
+ childInterp = GetInterp(interp, objv[2]);
+ if (childInterp == NULL) {
return TCL_ERROR;
}
aliasName = TclGetString(objv[3]);
- iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
- hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+ iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
+ hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"alias \"%s\" in path \"%s\" not found",
@@ -1167,46 +1168,46 @@ GetInterp2(
* A standard Tcl result.
*
* Side effects:
- * Creates a new alias, manipulates the result field of slaveInterp.
+ * Creates a new alias, manipulates the result field of childInterp.
*
*----------------------------------------------------------------------
*/
int
Tcl_CreateAlias(
- Tcl_Interp *slaveInterp, /* Interpreter for source command. */
- const char *slaveCmd, /* Command to install in slave. */
+ Tcl_Interp *childInterp, /* Interpreter for source command. */
+ const char *childCmd, /* Command to install in child. */
Tcl_Interp *targetInterp, /* Interpreter for target command. */
const char *targetCmd, /* Name of target command. */
int argc, /* How many additional arguments? */
const char *const *argv) /* These are the additional args. */
{
- Tcl_Obj *slaveObjPtr, *targetObjPtr;
+ Tcl_Obj *childObjPtr, *targetObjPtr;
Tcl_Obj **objv;
int i;
int result;
- objv = (Tcl_Obj **)TclStackAlloc(slaveInterp, sizeof(Tcl_Obj *) * argc);
+ objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc);
for (i = 0; i < argc; i++) {
objv[i] = Tcl_NewStringObj(argv[i], -1);
Tcl_IncrRefCount(objv[i]);
}
- slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
- Tcl_IncrRefCount(slaveObjPtr);
+ childObjPtr = Tcl_NewStringObj(childCmd, -1);
+ Tcl_IncrRefCount(childObjPtr);
targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
Tcl_IncrRefCount(targetObjPtr);
- result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
+ result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
targetObjPtr, argc, objv);
for (i = 0; i < argc; i++) {
Tcl_DecrRefCount(objv[i]);
}
- TclStackFree(slaveInterp, objv);
+ TclStackFree(childInterp, objv);
Tcl_DecrRefCount(targetObjPtr);
- Tcl_DecrRefCount(slaveObjPtr);
+ Tcl_DecrRefCount(childObjPtr);
return result;
}
@@ -1229,26 +1230,26 @@ Tcl_CreateAlias(
int
Tcl_CreateAliasObj(
- Tcl_Interp *slaveInterp, /* Interpreter for source command. */
- const char *slaveCmd, /* Command to install in slave. */
+ Tcl_Interp *childInterp, /* Interpreter for source command. */
+ const char *childCmd, /* Command to install in child. */
Tcl_Interp *targetInterp, /* Interpreter for target command. */
const char *targetCmd, /* Name of target command. */
int objc, /* How many additional arguments? */
Tcl_Obj *const objv[]) /* Argument vector. */
{
- Tcl_Obj *slaveObjPtr, *targetObjPtr;
+ Tcl_Obj *childObjPtr, *targetObjPtr;
int result;
- slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
- Tcl_IncrRefCount(slaveObjPtr);
+ childObjPtr = Tcl_NewStringObj(childCmd, -1);
+ Tcl_IncrRefCount(childObjPtr);
targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
Tcl_IncrRefCount(targetObjPtr);
- result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
+ result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
targetObjPtr, objc, objv);
- Tcl_DecrRefCount(slaveObjPtr);
+ Tcl_DecrRefCount(childObjPtr);
Tcl_DecrRefCount(targetObjPtr);
return result;
}
@@ -1285,7 +1286,7 @@ Tcl_GetAlias(
int i, objc;
Tcl_Obj **objv;
- hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+ hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"alias \"%s\" not found", aliasName));
@@ -1347,7 +1348,7 @@ Tcl_GetAliasObj(
int objc;
Tcl_Obj **objv;
- hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+ hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"alias \"%s\" not found", aliasName));
@@ -1435,7 +1436,7 @@ TclPreventAliasLoop(
if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {
/*
- * The slave interpreter can be deleted while creating the alias.
+ * The child interpreter can be deleted while creating the alias.
* [Bug #641195]
*/
@@ -1488,7 +1489,7 @@ TclPreventAliasLoop(
*
* Side effects:
* An alias command is created and entered into the alias table for the
- * slave interpreter.
+ * child interpreter.
*
*----------------------------------------------------------------------
*/
@@ -1496,9 +1497,9 @@ TclPreventAliasLoop(
static int
AliasCreate(
Tcl_Interp *interp, /* Interp for error reporting. */
- Tcl_Interp *slaveInterp, /* Interp where alias cmd will live or from
+ Tcl_Interp *childInterp, /* Interp where alias cmd will live or from
* which alias will be deleted. */
- Tcl_Interp *masterInterp, /* Interp in which target command will be
+ Tcl_Interp *parentInterp, /* Interp in which target command will be
* invoked. */
Tcl_Obj *namePtr, /* Name of alias cmd. */
Tcl_Obj *targetNamePtr, /* Name of target cmd. */
@@ -1508,15 +1509,15 @@ AliasCreate(
Alias *aliasPtr;
Tcl_HashEntry *hPtr;
Target *targetPtr;
- Slave *slavePtr;
- Master *masterPtr;
+ Child *childPtr;
+ Parent *parentPtr;
Tcl_Obj **prefv;
int isNew, i;
aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
aliasPtr->token = namePtr;
Tcl_IncrRefCount(aliasPtr->token);
- aliasPtr->targetInterp = masterInterp;
+ aliasPtr->targetInterp = parentInterp;
aliasPtr->objc = objc + 1;
prefv = &aliasPtr->objPtr;
@@ -1528,21 +1529,21 @@ AliasCreate(
Tcl_IncrRefCount(objv[i]);
}
- Tcl_Preserve(slaveInterp);
- Tcl_Preserve(masterInterp);
+ Tcl_Preserve(childInterp);
+ Tcl_Preserve(parentInterp);
- if (slaveInterp == masterInterp) {
- aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
+ if (childInterp == parentInterp) {
+ aliasPtr->childCmd = Tcl_NRCreateCommand(childInterp,
TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
aliasPtr, AliasObjCmdDeleteProc);
} else {
- aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
+ aliasPtr->childCmd = Tcl_CreateObjCommand(childInterp,
TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
AliasObjCmdDeleteProc);
}
- if (TclPreventAliasLoop(interp, slaveInterp,
- aliasPtr->slaveCmd) != TCL_OK) {
+ if (TclPreventAliasLoop(interp, childInterp,
+ aliasPtr->childCmd) != TCL_OK) {
/*
* Found an alias loop! The last call to Tcl_CreateObjCommand made the
* alias point to itself. Delete the command and its alias record. Be
@@ -1558,11 +1559,11 @@ AliasCreate(
Tcl_DecrRefCount(objv[i]);
}
- cmdPtr = (Command *) aliasPtr->slaveCmd;
+ cmdPtr = (Command *) aliasPtr->childCmd;
cmdPtr->clientData = NULL;
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = NULL;
- Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
+ Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
ckfree(aliasPtr);
@@ -1570,8 +1571,8 @@ AliasCreate(
* The result was already set by TclPreventAliasLoop.
*/
- Tcl_Release(slaveInterp);
- Tcl_Release(masterInterp);
+ Tcl_Release(childInterp);
+ Tcl_Release(parentInterp);
return TCL_ERROR;
}
@@ -1579,13 +1580,13 @@ AliasCreate(
* Make an entry in the alias table. If it already exists, retry.
*/
- slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
while (1) {
Tcl_Obj *newToken;
const char *string;
string = TclGetString(aliasPtr->token);
- hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
+ hPtr = Tcl_CreateHashEntry(&childPtr->aliasTable, string, &isNew);
if (isNew != 0) {
break;
}
@@ -1622,22 +1623,22 @@ AliasCreate(
*/
targetPtr = (Target *)ckalloc(sizeof(Target));
- targetPtr->slaveCmd = aliasPtr->slaveCmd;
- targetPtr->slaveInterp = slaveInterp;
+ targetPtr->childCmd = aliasPtr->childCmd;
+ targetPtr->childInterp = childInterp;
- masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
- targetPtr->nextPtr = masterPtr->targetsPtr;
+ parentPtr = &((InterpInfo*) ((Interp*) parentInterp)->interpInfo)->parent;
+ targetPtr->nextPtr = parentPtr->targetsPtr;
targetPtr->prevPtr = NULL;
- if (masterPtr->targetsPtr != NULL) {
- masterPtr->targetsPtr->prevPtr = targetPtr;
+ if (parentPtr->targetsPtr != NULL) {
+ parentPtr->targetsPtr->prevPtr = targetPtr;
}
- masterPtr->targetsPtr = targetPtr;
+ parentPtr->targetsPtr = targetPtr;
aliasPtr->targetPtr = targetPtr;
Tcl_SetObjResult(interp, aliasPtr->token);
- Tcl_Release(slaveInterp);
- Tcl_Release(masterInterp);
+ Tcl_Release(childInterp);
+ Tcl_Release(parentInterp);
return TCL_OK;
}
@@ -1646,13 +1647,13 @@ AliasCreate(
*
* AliasDelete --
*
- * Deletes the given alias from the slave interpreter given.
+ * Deletes the given alias from the child interpreter given.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Deletes the alias from the slave interpreter.
+ * Deletes the alias from the child interpreter.
*
*----------------------------------------------------------------------
*/
@@ -1660,21 +1661,21 @@ AliasCreate(
static int
AliasDelete(
Tcl_Interp *interp, /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp, /* Interpreter containing alias. */
+ Tcl_Interp *childInterp, /* Interpreter containing alias. */
Tcl_Obj *namePtr) /* Name of alias to delete. */
{
- Slave *slavePtr;
+ Child *childPtr;
Alias *aliasPtr;
Tcl_HashEntry *hPtr;
/*
- * If the alias has been renamed in the slave, the master can still use
+ * If the alias has been renamed in the child, the parent can still use
* the original name (with which it was created) to find the alias to
* delete it.
*/
- slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
- hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
+ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
+ hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr));
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"alias \"%s\" not found", TclGetString(namePtr)));
@@ -1683,7 +1684,7 @@ AliasDelete(
return TCL_ERROR;
}
aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
- Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
+ Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
return TCL_OK;
}
@@ -1708,22 +1709,22 @@ AliasDelete(
static int
AliasDescribe(
Tcl_Interp *interp, /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp, /* Interpreter containing alias. */
+ Tcl_Interp *childInterp, /* Interpreter containing alias. */
Tcl_Obj *namePtr) /* Name of alias to describe. */
{
- Slave *slavePtr;
+ Child *childPtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
Tcl_Obj *prefixPtr;
/*
- * If the alias has been renamed in the slave, the master can still use
+ * If the alias has been renamed in the child, the parent can still use
* the original name (with which it was created) to find the alias to
* describe it.
*/
- slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
- hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
+ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
+ hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, Tcl_GetString(namePtr));
if (hPtr == NULL) {
return TCL_OK;
}
@@ -1738,7 +1739,7 @@ AliasDescribe(
*
* AliasList --
*
- * Computes a list of aliases defined in a slave interpreter.
+ * Computes a list of aliases defined in a child interpreter.
*
* Results:
* A standard Tcl result.
@@ -1752,17 +1753,17 @@ AliasDescribe(
static int
AliasList(
Tcl_Interp *interp, /* Interp for data return. */
- Tcl_Interp *slaveInterp) /* Interp whose aliases to compute. */
+ Tcl_Interp *childInterp) /* Interp whose aliases to compute. */
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch hashSearch;
Tcl_Obj *resultPtr = Tcl_NewObj();
Alias *aliasPtr;
- Slave *slavePtr;
+ Child *childPtr;
- slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
- entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
+ entryPtr = Tcl_FirstHashEntry(&childPtr->aliasTable, &hashSearch);
for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
aliasPtr = (Alias *)Tcl_GetHashValue(entryPtr);
Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token);
@@ -1776,10 +1777,10 @@ AliasList(
*
* TclAliasObjCmd, TclLocalAliasObjCmd --
*
- * This is the function that services invocations of aliases in a slave
+ * This is the function that services invocations of aliases in a child
* interpreter. One such command exists for each alias. When invoked,
* this function redirects the invocation to the target command in the
- * master interpreter as designated by the Alias record associated with
+ * parent interpreter as designated by the Alias record associated with
* this command.
*
* TclLocalAliasObjCmd is a stripped down version used when the source
@@ -2009,7 +2010,7 @@ TclLocalAliasObjCmd(
*
* AliasObjCmdDeleteProc --
*
- * Is invoked when an alias command is deleted in a slave. Cleans up all
+ * Is invoked when an alias command is deleted in a child. Cleans up all
* storage associated with this alias.
*
* Results:
@@ -2039,17 +2040,17 @@ AliasObjCmdDeleteProc(
Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);
/*
- * Splice the target record out of the target interpreter's master list.
+ * Splice the target record out of the target interpreter's parent list.
*/
targetPtr = aliasPtr->targetPtr;
if (targetPtr->prevPtr != NULL) {
targetPtr->prevPtr->nextPtr = targetPtr->nextPtr;
} else {
- Master *masterPtr = &((InterpInfo *) ((Interp *)
- aliasPtr->targetInterp)->interpInfo)->master;
+ Parent *parentPtr = &((InterpInfo *) ((Interp *)
+ aliasPtr->targetInterp)->interpInfo)->parent;
- masterPtr->targetsPtr = targetPtr->nextPtr;
+ parentPtr->targetsPtr = targetPtr->nextPtr;
}
if (targetPtr->nextPtr != NULL) {
targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
@@ -2062,13 +2063,13 @@ AliasObjCmdDeleteProc(
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateSlave --
+ * Tcl_CreateChild --
*
- * Creates a slave interpreter. The slavePath argument denotes the name
- * of the new slave relative to the current interpreter; the slave is a
+ * Creates a child interpreter. The childPath argument denotes the name
+ * of the new child relative to the current interpreter; the child is a
* direct descendant of the one-before-last component of the path,
- * e.g. it is a descendant of the current interpreter if the slavePath
- * argument contains only one component. Optionally makes the slave
+ * e.g. it is a descendant of the current interpreter if the childPath
+ * argument contains only one component. Optionally makes the child
* interpreter safe.
*
* Results:
@@ -2077,33 +2078,33 @@ AliasObjCmdDeleteProc(
*
* Side effects:
* Creates a new interpreter and a new interpreter object command in the
- * interpreter indicated by the slavePath argument.
+ * interpreter indicated by the childPath argument.
*
*----------------------------------------------------------------------
*/
Tcl_Interp *
-Tcl_CreateSlave(
+Tcl_CreateChild(
Tcl_Interp *interp, /* Interpreter to start search at. */
- const char *slavePath, /* Name of slave to create. */
- int isSafe) /* Should new slave be "safe" ? */
+ const char *childPath, /* Name of child to create. */
+ int isSafe) /* Should new child be "safe" ? */
{
Tcl_Obj *pathPtr;
- Tcl_Interp *slaveInterp;
+ Tcl_Interp *childInterp;
- pathPtr = Tcl_NewStringObj(slavePath, -1);
- slaveInterp = SlaveCreate(interp, pathPtr, isSafe);
+ pathPtr = Tcl_NewStringObj(childPath, -1);
+ childInterp = ChildCreate(interp, pathPtr, isSafe);
Tcl_DecrRefCount(pathPtr);
- return slaveInterp;
+ return childInterp;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetSlave --
+ * Tcl_GetChild --
*
- * Finds a slave interpreter by its path name.
+ * Finds a child interpreter by its path name.
*
* Results:
* Returns a Tcl_Interp * for the named interpreter or NULL if not found.
@@ -2115,29 +2116,29 @@ Tcl_CreateSlave(
*/
Tcl_Interp *
-Tcl_GetSlave(
+Tcl_GetChild(
Tcl_Interp *interp, /* Interpreter to start search from. */
- const char *slavePath) /* Path of slave to find. */
+ const char *childPath) /* Path of child to find. */
{
Tcl_Obj *pathPtr;
- Tcl_Interp *slaveInterp;
+ Tcl_Interp *childInterp;
- pathPtr = Tcl_NewStringObj(slavePath, -1);
- slaveInterp = GetInterp(interp, pathPtr);
+ pathPtr = Tcl_NewStringObj(childPath, -1);
+ childInterp = GetInterp(interp, pathPtr);
Tcl_DecrRefCount(pathPtr);
- return slaveInterp;
+ return childInterp;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetMaster --
+ * Tcl_GetParent --
*
- * Finds the master interpreter of a slave interpreter.
+ * Finds the parent interpreter of a child interpreter.
*
* Results:
- * Returns a Tcl_Interp * for the master interpreter or NULL if none.
+ * Returns a Tcl_Interp * for the parent interpreter or NULL if none.
*
* Side effects:
* None.
@@ -2146,24 +2147,24 @@ Tcl_GetSlave(
*/
Tcl_Interp *
-Tcl_GetMaster(
- Tcl_Interp *interp) /* Get the master of this interpreter. */
+Tcl_GetParent(
+ Tcl_Interp *interp) /* Get the parent of this interpreter. */
{
- Slave *slavePtr; /* Slave record of this interpreter. */
+ Child *childPtr; /* Child record of this interpreter. */
if (interp == NULL) {
return NULL;
}
- slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
- return slavePtr->masterInterp;
+ childPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->child;
+ return childPtr->parentInterp;
}
/*
*----------------------------------------------------------------------
*
- * TclSetSlaveCancelFlags --
+ * TclSetChildCancelFlags --
*
- * This function marks all slave interpreters belonging to a given
+ * This function marks all child interpreters belonging to a given
* interpreter as being canceled or not canceled, depending on the
* provided flags.
*
@@ -2177,7 +2178,7 @@ Tcl_GetMaster(
*/
void
-TclSetSlaveCancelFlags(
+TclSetChildCancelFlags(
Tcl_Interp *interp, /* Set cancel flags of this interpreter. */
int flags, /* Collection of OR-ed bits that control
* the cancellation of the script. Only
@@ -2186,10 +2187,10 @@ TclSetSlaveCancelFlags(
int force) /* Non-zero to ignore numLevels for the purpose
* of resetting the cancellation flags. */
{
- Master *masterPtr; /* Master record of given interpreter. */
+ Parent *parentPtr; /* Parent record of given interpreter. */
Tcl_HashEntry *hPtr; /* Search element. */
Tcl_HashSearch hashSearch; /* Search variable. */
- Slave *slavePtr; /* Slave record of interpreter. */
+ Child *childPtr; /* Child record of interpreter. */
Interp *iPtr;
if (interp == NULL) {
@@ -2198,12 +2199,12 @@ TclSetSlaveCancelFlags(
flags &= (CANCELED | TCL_CANCEL_UNWIND);
- masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master;
+ parentPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->parent;
- hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch);
+ hPtr = Tcl_FirstHashEntry(&parentPtr->childTable, &hashSearch);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
- slavePtr = (Slave *)Tcl_GetHashValue(hPtr);
- iPtr = (Interp *) slavePtr->slaveInterp;
+ childPtr = (Child *)Tcl_GetHashValue(hPtr);
+ iPtr = (Interp *) childPtr->childInterp;
if (iPtr == NULL) {
continue;
@@ -2216,11 +2217,11 @@ TclSetSlaveCancelFlags(
}
/*
- * Now, recursively handle this for the slaves of this slave
+ * Now, recursively handle this for the children of this child
* interpreter.
*/
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force);
+ TclSetChildCancelFlags((Tcl_Interp *) iPtr, flags, force);
}
}
@@ -2232,7 +2233,7 @@ TclSetSlaveCancelFlags(
* Sets the result of the asking interpreter to a proper Tcl list
* containing the names of interpreters between the asking and target
* interpreters. The target interpreter must be either the same as the
- * asking interpreter or one of its slaves (including recursively).
+ * asking interpreter or one of its children (including recursively).
*
* Results:
* TCL_OK if the target interpreter is the same as, or a descendant of,
@@ -2250,25 +2251,25 @@ TclSetSlaveCancelFlags(
int
Tcl_GetInterpPath(
- Tcl_Interp *askingInterp, /* Interpreter to start search from. */
+ Tcl_Interp *interp, /* Interpreter to start search from. */
Tcl_Interp *targetInterp) /* Interpreter to find. */
{
InterpInfo *iiPtr;
- if (targetInterp == askingInterp) {
- Tcl_SetObjResult(askingInterp, Tcl_NewObj());
+ if (targetInterp == interp) {
+ Tcl_SetObjResult(interp, Tcl_NewObj());
return TCL_OK;
}
if (targetInterp == NULL) {
return TCL_ERROR;
}
iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
- if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){
+ if (Tcl_GetInterpPath(interp, iiPtr->child.parentInterp) != TCL_OK){
return TCL_ERROR;
}
- Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp),
- Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->master.slaveTable,
- iiPtr->slave.slaveEntryPtr), -1));
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->parent.childTable,
+ iiPtr->child.childEntryPtr), -1));
return TCL_OK;
}
@@ -2277,10 +2278,10 @@ Tcl_GetInterpPath(
*
* GetInterp --
*
- * Helper function to find a slave interpreter given a pathname.
+ * Helper function to find a child interpreter given a pathname.
*
* Results:
- * Returns the slave interpreter known by that name in the calling
+ * Returns the child interpreter known by that name in the calling
* interpreter, or NULL if no interpreter known by that name exists.
*
* Side effects:
@@ -2296,11 +2297,11 @@ GetInterp(
* be found. */
{
Tcl_HashEntry *hPtr; /* Search element. */
- Slave *slavePtr; /* Interim slave record. */
+ Child *childPtr; /* Interim child record. */
Tcl_Obj **objv;
int objc, i;
Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */
- InterpInfo *masterInfoPtr;
+ InterpInfo *parentInfoPtr;
if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
return NULL;
@@ -2308,15 +2309,15 @@ GetInterp(
searchInterp = interp;
for (i = 0; i < objc; i++) {
- masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
- hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
+ parentInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
+ hPtr = Tcl_FindHashEntry(&parentInfoPtr->parent.childTable,
TclGetString(objv[i]));
if (hPtr == NULL) {
searchInterp = NULL;
break;
}
- slavePtr = (Slave *)Tcl_GetHashValue(hPtr);
- searchInterp = slavePtr->slaveInterp;
+ childPtr = (Child *)Tcl_GetHashValue(hPtr);
+ searchInterp = childPtr->childInterp;
if (searchInterp == NULL) {
break;
}
@@ -2333,7 +2334,7 @@ GetInterp(
/*
*----------------------------------------------------------------------
*
- * SlaveBgerror --
+ * ChildBgerror --
*
* Helper function to set/query the background error handling command
* prefix of an interp
@@ -2342,16 +2343,16 @@ GetInterp(
* A standard Tcl result.
*
* Side effects:
- * When (objc == 1), slaveInterp will be set to a new background handler
+ * When (objc == 1), childInterp will be set to a new background handler
* of objv[0].
*
*----------------------------------------------------------------------
*/
static int
-SlaveBgerror(
+ChildBgerror(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */
+ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */
int objc, /* Set or Query. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
@@ -2366,19 +2367,19 @@ SlaveBgerror(
"BGERRORFORMAT", NULL);
return TCL_ERROR;
}
- TclSetBgErrorHandler(slaveInterp, objv[0]);
+ TclSetBgErrorHandler(childInterp, objv[0]);
}
- Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp));
+ Tcl_SetObjResult(interp, TclGetBgErrorHandler(childInterp));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * SlaveCreate --
+ * ChildCreate --
*
- * Helper function to do the actual work of creating a slave interp and
- * new object command. Also optionally makes the new slave interpreter
+ * Helper function to do the actual work of creating a child interp and
+ * new object command. Also optionally makes the new child interpreter
* "safe".
*
* Results:
@@ -2386,20 +2387,20 @@ SlaveBgerror(
* the result of the invoking interpreter contains an error message.
*
* Side effects:
- * Creates a new slave interpreter and a new object command.
+ * Creates a new child interpreter and a new object command.
*
*----------------------------------------------------------------------
*/
static Tcl_Interp *
-SlaveCreate(
+ChildCreate(
Tcl_Interp *interp, /* Interp. to start search from. */
- Tcl_Obj *pathPtr, /* Path (name) of slave to create. */
+ Tcl_Obj *pathPtr, /* Path (name) of child to create. */
int safe) /* Should we make it "safe"? */
{
- Tcl_Interp *masterInterp, *slaveInterp;
- Slave *slavePtr;
- InterpInfo *masterInfoPtr;
+ Tcl_Interp *parentInterp, *childInterp;
+ Child *childPtr;
+ InterpInfo *parentInfoPtr;
Tcl_HashEntry *hPtr;
const char *path;
int isNew, objc;
@@ -2409,25 +2410,25 @@ SlaveCreate(
return NULL;
}
if (objc < 2) {
- masterInterp = interp;
+ parentInterp = interp;
path = TclGetString(pathPtr);
} else {
Tcl_Obj *objPtr;
objPtr = Tcl_NewListObj(objc - 1, objv);
- masterInterp = GetInterp(interp, objPtr);
+ parentInterp = GetInterp(interp, objPtr);
Tcl_DecrRefCount(objPtr);
- if (masterInterp == NULL) {
+ if (parentInterp == NULL) {
return NULL;
}
path = TclGetString(objv[objc - 1]);
}
if (safe == 0) {
- safe = Tcl_IsSafe(masterInterp);
+ safe = Tcl_IsSafe(parentInterp);
}
- masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
- hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
+ parentInfoPtr = (InterpInfo *) ((Interp *) parentInterp)->interpInfo;
+ hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path,
&isNew);
if (isNew == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2436,51 +2437,51 @@ SlaveCreate(
return NULL;
}
- slaveInterp = Tcl_CreateInterp();
- slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
- slavePtr->masterInterp = masterInterp;
- slavePtr->slaveEntryPtr = hPtr;
- slavePtr->slaveInterp = slaveInterp;
- slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
- TclSlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
- Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
- Tcl_SetHashValue(hPtr, slavePtr);
- Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
+ childInterp = Tcl_CreateInterp();
+ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
+ childPtr->parentInterp = parentInterp;
+ childPtr->childEntryPtr = hPtr;
+ childPtr->childInterp = childInterp;
+ childPtr->interpCmd = Tcl_NRCreateCommand(parentInterp, path,
+ TclChildObjCmd, NRChildCmd, childInterp, ChildObjCmdDeleteProc);
+ Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
+ Tcl_SetHashValue(hPtr, childPtr);
+ Tcl_SetVar2(childInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
/*
* Inherit the recursion limit.
*/
- ((Interp *) slaveInterp)->maxNestingDepth =
- ((Interp *) masterInterp)->maxNestingDepth;
+ ((Interp *) childInterp)->maxNestingDepth =
+ ((Interp *) parentInterp)->maxNestingDepth;
if (safe) {
- if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
+ if (Tcl_MakeSafe(childInterp) == TCL_ERROR) {
goto error;
}
} else {
- if (Tcl_Init(slaveInterp) == TCL_ERROR) {
+ if (Tcl_Init(childInterp) == TCL_ERROR) {
goto error;
}
/*
- * This will create the "memory" command in slave interpreters if we
+ * This will create the "memory" command in child interpreters if we
* compiled with TCL_MEM_DEBUG, otherwise it does nothing.
*/
- Tcl_InitMemory(slaveInterp);
+ Tcl_InitMemory(childInterp);
}
/*
* Inherit the TIP#143 limits.
*/
- InheritLimitsFromMaster(slaveInterp, masterInterp);
+ InheritLimitsFromParent(childInterp, parentInterp);
/*
* The [clock] command presents a safe API, but uses unsafe features in
* its implementation. This means it has to be implemented in safe interps
- * as an alias to a version in the (trusted) master.
+ * as an alias to a version in the (trusted) parent.
*/
if (safe) {
@@ -2489,7 +2490,7 @@ SlaveCreate(
TclNewLiteralStringObj(clockObj, "clock");
Tcl_IncrRefCount(clockObj);
- status = AliasCreate(interp, slaveInterp, masterInterp, clockObj,
+ status = AliasCreate(interp, childInterp, parentInterp, clockObj,
clockObj, 0, NULL);
Tcl_DecrRefCount(clockObj);
if (status != TCL_OK) {
@@ -2497,12 +2498,12 @@ SlaveCreate(
}
}
- return slaveInterp;
+ return childInterp;
error:
- Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_TransferResult(childInterp, TCL_ERROR, interp);
error2:
- Tcl_DeleteInterp(slaveInterp);
+ Tcl_DeleteInterp(childInterp);
return NULL;
}
@@ -2510,10 +2511,10 @@ SlaveCreate(
/*
*----------------------------------------------------------------------
*
- * TclSlaveObjCmd --
+ * TclChildObjCmd --
*
* Command to manipulate an interpreter, e.g. to send commands to it to
- * be evaluated. One such command exists for each slave interpreter.
+ * be evaluated. One such command exists for each child interpreter.
*
* Results:
* A standard Tcl result.
@@ -2525,23 +2526,23 @@ SlaveCreate(
*/
int
-TclSlaveObjCmd(
- ClientData clientData, /* Slave interpreter. */
+TclChildObjCmd(
+ ClientData clientData, /* Child interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
+ return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv);
}
static int
-NRSlaveCmd(
- ClientData clientData, /* Slave interpreter. */
+NRChildCmd(
+ ClientData clientData, /* Child interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Interp *slaveInterp = (Tcl_Interp *)clientData;
+ Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
int index;
static const char *const options[] = {
"alias", "aliases", "bgerror", "debug",
@@ -2556,8 +2557,8 @@ NRSlaveCmd(
OPT_RECLIMIT
};
- if (slaveInterp == NULL) {
- Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted");
+ if (childInterp == NULL) {
+ Tcl_Panic("TclChildObjCmd: interpreter has been deleted");
}
if (objc < 2) {
@@ -2573,14 +2574,14 @@ NRSlaveCmd(
case OPT_ALIAS:
if (objc > 2) {
if (objc == 3) {
- return AliasDescribe(interp, slaveInterp, objv[2]);
+ return AliasDescribe(interp, childInterp, objv[2]);
}
if (TclGetString(objv[3])[0] == '\0') {
if (objc == 4) {
- return AliasDelete(interp, slaveInterp, objv[2]);
+ return AliasDelete(interp, childInterp, objv[2]);
}
} else {
- return AliasCreate(interp, slaveInterp, interp, objv[2],
+ return AliasCreate(interp, childInterp, interp, objv[2],
objv[3], objc - 4, objv + 4);
}
}
@@ -2591,13 +2592,13 @@ NRSlaveCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- return AliasList(interp, slaveInterp);
+ return AliasList(interp, childInterp);
case OPT_BGERROR:
if (objc != 2 && objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?cmdPrefix?");
return TCL_ERROR;
}
- return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
+ return ChildBgerror(interp, childInterp, objc - 2, objv + 2);
case OPT_DEBUG:
/*
* TIP #378
@@ -2607,37 +2608,37 @@ NRSlaveCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
return TCL_ERROR;
}
- return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
+ return ChildDebugCmd(interp, childInterp, objc - 2, objv + 2);
case OPT_EVAL:
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
return TCL_ERROR;
}
- return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
+ return ChildEval(interp, childInterp, objc - 2, objv + 2);
case OPT_EXPOSE:
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
return TCL_ERROR;
}
- return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);
+ return ChildExpose(interp, childInterp, objc - 2, objv + 2);
case OPT_HIDE:
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
return TCL_ERROR;
}
- return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
+ return ChildHide(interp, childInterp, objc - 2, objv + 2);
case OPT_HIDDEN:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- return SlaveHidden(interp, slaveInterp);
+ return ChildHidden(interp, childInterp);
case OPT_ISSAFE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp)));
return TCL_OK;
case OPT_INVOKEHIDDEN: {
int i;
@@ -2676,7 +2677,7 @@ NRSlaveCmd(
"?-namespace ns? ?-global? ?--? cmd ?arg ..?");
return TCL_ERROR;
}
- return SlaveInvokeHidden(interp, slaveInterp, namespaceName,
+ return ChildInvokeHidden(interp, childInterp, namespaceName,
objc - i, objv + i);
}
case OPT_LIMIT: {
@@ -2698,9 +2699,9 @@ NRSlaveCmd(
}
switch ((enum LimitTypes) limitType) {
case LIMIT_TYPE_COMMANDS:
- return SlaveCommandLimitCmd(interp, slaveInterp, 3, objc,objv);
+ return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv);
case LIMIT_TYPE_TIME:
- return SlaveTimeLimitCmd(interp, slaveInterp, 3, objc, objv);
+ return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv);
}
}
break;
@@ -2709,13 +2710,13 @@ NRSlaveCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- return SlaveMarkTrusted(interp, slaveInterp);
+ return ChildMarkTrusted(interp, childInterp);
case OPT_RECLIMIT:
if (objc != 2 && objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
return TCL_ERROR;
}
- return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
+ return ChildRecursionLimit(interp, childInterp, objc - 2, objv + 2);
}
return TCL_ERROR;
@@ -2724,71 +2725,71 @@ NRSlaveCmd(
/*
*----------------------------------------------------------------------
*
- * SlaveObjCmdDeleteProc --
+ * ChildObjCmdDeleteProc --
*
- * Invoked when an object command for a slave interpreter is deleted;
- * cleans up all state associated with the slave interpreter and destroys
- * the slave interpreter.
+ * Invoked when an object command for a child interpreter is deleted;
+ * cleans up all state associated with the child interpreter and destroys
+ * the child interpreter.
*
* Results:
* None.
*
* Side effects:
- * Cleans up all state associated with the slave interpreter and destroys
- * the slave interpreter.
+ * Cleans up all state associated with the child interpreter and destroys
+ * the child interpreter.
*
*----------------------------------------------------------------------
*/
static void
-SlaveObjCmdDeleteProc(
- ClientData clientData) /* The SlaveRecord for the command. */
+ChildObjCmdDeleteProc(
+ ClientData clientData) /* The ChildRecord for the command. */
{
- Slave *slavePtr; /* Interim storage for Slave record. */
- Tcl_Interp *slaveInterp = (Tcl_Interp *)clientData;
- /* And for a slave interp. */
+ Child *childPtr; /* Interim storage for Child record. */
+ Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
+ /* And for a child interp. */
- slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
/*
- * Unlink the slave from its master interpreter.
+ * Unlink the child from its parent interpreter.
*/
- Tcl_DeleteHashEntry(slavePtr->slaveEntryPtr);
+ Tcl_DeleteHashEntry(childPtr->childEntryPtr);
/*
- * Set to NULL so that when the InterpInfo is cleaned up in the slave it
+ * Set to NULL so that when the InterpInfo is cleaned up in the child it
* does not try to delete the command causing all sorts of grief. See
- * SlaveRecordDeleteProc().
+ * ChildRecordDeleteProc().
*/
- slavePtr->interpCmd = NULL;
+ childPtr->interpCmd = NULL;
- if (slavePtr->slaveInterp != NULL) {
- Tcl_DeleteInterp(slavePtr->slaveInterp);
+ if (childPtr->childInterp != NULL) {
+ Tcl_DeleteInterp(childPtr->childInterp);
}
}
/*
*----------------------------------------------------------------------
*
- * SlaveDebugCmd -- TIP #378
+ * ChildDebugCmd -- TIP #378
*
- * Helper function to handle 'debug' command in a slave interpreter.
+ * Helper function to handle 'debug' command in a child interpreter.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * May modify INTERP_DEBUG_FRAME flag in the slave.
+ * May modify INTERP_DEBUG_FRAME flag in the child.
*
*----------------------------------------------------------------------
*/
static int
-SlaveDebugCmd(
+ChildDebugCmd(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* The slave interpreter in which command
+ Tcl_Interp *childInterp, /* The child interpreter in which command
* will be evaluated. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2803,7 +2804,7 @@ SlaveDebugCmd(
Interp *iPtr;
Tcl_Obj *resultPtr;
- iPtr = (Interp *) slaveInterp;
+ iPtr = (Interp *) childInterp;
if (objc == 0) {
resultPtr = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, resultPtr,
@@ -2843,9 +2844,9 @@ SlaveDebugCmd(
/*
*----------------------------------------------------------------------
*
- * SlaveEval --
+ * ChildEval --
*
- * Helper function to evaluate a command in a slave interpreter.
+ * Helper function to evaluate a command in a child interpreter.
*
* Results:
* A standard Tcl result.
@@ -2857,9 +2858,9 @@ SlaveDebugCmd(
*/
static int
-SlaveEval(
+ChildEval(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* The slave interpreter in which command
+ Tcl_Interp *childInterp, /* The child interpreter in which command
* will be evaluated. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2867,17 +2868,17 @@ SlaveEval(
int result;
/*
- * TIP #285: If necessary, reset the cancellation flags for the slave
- * interpreter now; otherwise, canceling a script in a master interpreter
- * can result in a situation where a slave interpreter can no longer
+ * TIP #285: If necessary, reset the cancellation flags for the child
+ * interpreter now; otherwise, canceling a script in a parent interpreter
+ * can result in a situation where a child interpreter can no longer
* evaluate any scripts unless somebody calls the TclResetCancellation
* function for that particular Tcl_Interp.
*/
- TclSetSlaveCancelFlags(slaveInterp, 0, 0);
+ TclSetChildCancelFlags(childInterp, 0, 0);
- Tcl_Preserve(slaveInterp);
- Tcl_AllowExceptions(slaveInterp);
+ Tcl_Preserve(childInterp);
+ Tcl_AllowExceptions(childInterp);
if (objc == 1) {
/*
@@ -2890,40 +2891,40 @@ SlaveEval(
TclArgumentGet(interp, objv[0], &invoker, &word);
- result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
+ result = TclEvalObjEx(childInterp, objv[0], 0, invoker, word);
} else {
Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
- result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
+ result = Tcl_EvalObjEx(childInterp, objPtr, 0);
Tcl_DecrRefCount(objPtr);
}
- Tcl_TransferResult(slaveInterp, result, interp);
+ Tcl_TransferResult(childInterp, result, interp);
- Tcl_Release(slaveInterp);
+ Tcl_Release(childInterp);
return result;
}
/*
*----------------------------------------------------------------------
*
- * SlaveExpose --
+ * ChildExpose --
*
- * Helper function to expose a command in a slave interpreter.
+ * Helper function to expose a command in a child interpreter.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * After this call scripts in the slave will be able to invoke the newly
+ * After this call scripts in the child will be able to invoke the newly
* exposed command.
*
*----------------------------------------------------------------------
*/
static int
-SlaveExpose(
+ChildExpose(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */
+ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
@@ -2939,9 +2940,9 @@ SlaveExpose(
}
name = TclGetString(objv[(objc == 1) ? 0 : 1]);
- if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
+ if (Tcl_ExposeCommand(childInterp, TclGetString(objv[0]),
name) != TCL_OK) {
- Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_TransferResult(childInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -2950,7 +2951,7 @@ SlaveExpose(
/*
*----------------------------------------------------------------------
*
- * SlaveRecursionLimit --
+ * ChildRecursionLimit --
*
* Helper function to set/query the Recursion limit of an interp
*
@@ -2958,16 +2959,16 @@ SlaveExpose(
* A standard Tcl result.
*
* Side effects:
- * When (objc == 1), slaveInterp will be set to a new recursion limit of
+ * When (objc == 1), childInterp will be set to a new recursion limit of
* objv[0].
*
*----------------------------------------------------------------------
*/
static int
-SlaveRecursionLimit(
+ChildRecursionLimit(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */
+ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */
int objc, /* Set or Query. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
@@ -2992,9 +2993,9 @@ SlaveRecursionLimit(
NULL);
return TCL_ERROR;
}
- Tcl_SetRecursionLimit(slaveInterp, limit);
- iPtr = (Interp *) slaveInterp;
- if (interp == slaveInterp && iPtr->numLevels > limit) {
+ Tcl_SetRecursionLimit(childInterp, limit);
+ iPtr = (Interp *) childInterp;
+ if (interp == childInterp && iPtr->numLevels > limit) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"falling back due to new recursion limit", -1));
Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
@@ -3003,7 +3004,7 @@ SlaveRecursionLimit(
Tcl_SetObjResult(interp, objv[0]);
return TCL_OK;
} else {
- limit = Tcl_SetRecursionLimit(slaveInterp, 0);
+ limit = Tcl_SetRecursionLimit(childInterp, 0);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limit));
return TCL_OK;
}
@@ -3012,24 +3013,24 @@ SlaveRecursionLimit(
/*
*----------------------------------------------------------------------
*
- * SlaveHide --
+ * ChildHide --
*
- * Helper function to hide a command in a slave interpreter.
+ * Helper function to hide a command in a child interpreter.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * After this call scripts in the slave will no longer be able to invoke
+ * After this call scripts in the child will no longer be able to invoke
* the named command.
*
*----------------------------------------------------------------------
*/
static int
-SlaveHide(
+ChildHide(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */
+ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
@@ -3045,8 +3046,8 @@ SlaveHide(
}
name = TclGetString(objv[(objc == 1) ? 0 : 1]);
- if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
- Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ if (Tcl_HideCommand(childInterp, TclGetString(objv[0]), name) != TCL_OK) {
+ Tcl_TransferResult(childInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -3055,9 +3056,9 @@ SlaveHide(
/*
*----------------------------------------------------------------------
*
- * SlaveHidden --
+ * ChildHidden --
*
- * Helper function to compute list of hidden commands in a slave
+ * Helper function to compute list of hidden commands in a child
* interpreter.
*
* Results:
@@ -3070,16 +3071,16 @@ SlaveHide(
*/
static int
-SlaveHidden(
+ChildHidden(
Tcl_Interp *interp, /* Interp for data return. */
- Tcl_Interp *slaveInterp) /* Interp whose hidden commands to query. */
+ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */
{
Tcl_Obj *listObjPtr = Tcl_NewObj(); /* Local object pointer. */
Tcl_HashTable *hTblPtr; /* For local searches. */
Tcl_HashEntry *hPtr; /* For local searches. */
Tcl_HashSearch hSearch; /* For local searches. */
- hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
+ hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr;
if (hTblPtr != NULL) {
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL;
@@ -3095,9 +3096,9 @@ SlaveHidden(
/*
*----------------------------------------------------------------------
*
- * SlaveInvokeHidden --
+ * ChildInvokeHidden --
*
- * Helper function to invoke a hidden command in a slave interpreter.
+ * Helper function to invoke a hidden command in a child interpreter.
*
* Results:
* A standard Tcl result.
@@ -3109,9 +3110,9 @@ SlaveHidden(
*/
static int
-SlaveInvokeHidden(
+ChildInvokeHidden(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* The slave interpreter in which command will
+ Tcl_Interp *childInterp, /* The child interpreter in which command will
* be invoked. */
const char *namespaceName, /* The namespace to use, if any. */
int objc, /* Number of arguments. */
@@ -3128,31 +3129,31 @@ SlaveInvokeHidden(
return TCL_ERROR;
}
- Tcl_Preserve(slaveInterp);
- Tcl_AllowExceptions(slaveInterp);
+ Tcl_Preserve(childInterp);
+ Tcl_AllowExceptions(childInterp);
if (namespaceName == NULL) {
- NRE_callback *rootPtr = TOP_CB(slaveInterp);
+ NRE_callback *rootPtr = TOP_CB(childInterp);
- Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
+ Tcl_NRAddCallback(interp, NRPostInvokeHidden, childInterp,
rootPtr, NULL, NULL);
- return TclNRInvoke(NULL, slaveInterp, objc, objv);
+ return TclNRInvoke(NULL, childInterp, objc, objv);
} else {
Namespace *nsPtr, *dummy1, *dummy2;
const char *tail;
- result = TclGetNamespaceForQualName(slaveInterp, namespaceName, NULL,
+ result = TclGetNamespaceForQualName(childInterp, namespaceName, NULL,
TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG
| TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if (result == TCL_OK) {
- result = TclObjInvokeNamespace(slaveInterp, objc, objv,
+ result = TclObjInvokeNamespace(childInterp, objc, objv,
(Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN);
}
}
- Tcl_TransferResult(slaveInterp, result, interp);
+ Tcl_TransferResult(childInterp, result, interp);
- Tcl_Release(slaveInterp);
+ Tcl_Release(childInterp);
return result;
}
@@ -3162,38 +3163,38 @@ NRPostInvokeHidden(
Tcl_Interp *interp,
int result)
{
- Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
+ Tcl_Interp *childInterp = (Tcl_Interp *)data[0];
NRE_callback *rootPtr = (NRE_callback *)data[1];
- if (interp != slaveInterp) {
- result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
- Tcl_TransferResult(slaveInterp, result, interp);
+ if (interp != childInterp) {
+ result = TclNRRunCallbacks(childInterp, result, rootPtr);
+ Tcl_TransferResult(childInterp, result, interp);
}
- Tcl_Release(slaveInterp);
+ Tcl_Release(childInterp);
return result;
}
/*
*----------------------------------------------------------------------
*
- * SlaveMarkTrusted --
+ * ChildMarkTrusted --
*
- * Helper function to mark a slave interpreter as trusted (unsafe).
+ * Helper function to mark a child interpreter as trusted (unsafe).
*
* Results:
* A standard Tcl result.
*
* Side effects:
* After this call the hard-wired security checks in the core no longer
- * prevent the slave from performing certain operations.
+ * prevent the child from performing certain operations.
*
*----------------------------------------------------------------------
*/
static int
-SlaveMarkTrusted(
+ChildMarkTrusted(
Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp) /* The slave interpreter which will be marked
+ Tcl_Interp *childInterp) /* The child interpreter which will be marked
* trusted. */
{
if (Tcl_IsSafe(interp)) {
@@ -3204,7 +3205,7 @@ SlaveMarkTrusted(
NULL);
return TCL_ERROR;
}
- ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
+ ((Interp *) childInterp)->flags &= ~SAFE_INTERP;
return TCL_OK;
}
@@ -3261,14 +3262,14 @@ Tcl_MakeSafe(
{
Tcl_Channel chan; /* Channel to remove from safe interpreter. */
Interp *iPtr = (Interp *) interp;
- Tcl_Interp *master = ((InterpInfo*) iPtr->interpInfo)->slave.masterInterp;
+ Tcl_Interp *parent = ((InterpInfo*) iPtr->interpInfo)->child.parentInterp;
TclHideUnsafeCommands(interp);
- if (master != NULL) {
+ if (parent != NULL) {
/*
- * Alias these function implementations in the slave to those in the
- * master; the overall implementations are safe, but they're normally
+ * Alias these function implementations in the child to those in the
+ * parent; the overall implementations are safe, but they're normally
* defined by init.tcl which is not sourced by safe interpreters.
* Assume these functions all work. [Bug 2895741]
*/
@@ -3285,7 +3286,7 @@ Tcl_MakeSafe(
*/
/*
- * No env array in a safe slave.
+ * No env array in a safe interpreter.
*/
Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
@@ -4186,7 +4187,7 @@ Tcl_LimitGetGranularity(
* DeleteScriptLimitCallback --
*
* Callback for when a script limit (a limit callback implemented as a
- * Tcl script in a master interpreter, as set up from Tcl) is deleted.
+ * Tcl script in a parent interpreter, as set up from Tcl) is deleted.
*
* Results:
* None.
@@ -4399,48 +4400,48 @@ TclInitLimitSupport(
/*
*----------------------------------------------------------------------
*
- * InheritLimitsFromMaster --
+ * InheritLimitsFromParent --
*
- * Derive the interpreter limit configuration for a slave interpreter
- * from the limit config for the master.
+ * Derive the interpreter limit configuration for a child interpreter
+ * from the limit config for the parent.
*
* Results:
* None.
*
* Side effects:
- * The slave interpreter limits are set so that if the master has a
- * limit, it may not exceed it by handing off work to slave interpreters.
- * Note that this does not transfer limit callbacks from the master to
- * the slave.
+ * The child interpreter limits are set so that if the parent has a
+ * limit, it may not exceed it by handing off work to child interpreters.
+ * Note that this does not transfer limit callbacks from the parent to
+ * the child.
*
*----------------------------------------------------------------------
*/
static void
-InheritLimitsFromMaster(
- Tcl_Interp *slaveInterp,
- Tcl_Interp *masterInterp)
+InheritLimitsFromParent(
+ Tcl_Interp *childInterp,
+ Tcl_Interp *parentInterp)
{
- Interp *slavePtr = (Interp *) slaveInterp;
- Interp *masterPtr = (Interp *) masterInterp;
+ Interp *childPtr = (Interp *) childInterp;
+ Interp *parentPtr = (Interp *) parentInterp;
- if (masterPtr->limit.active & TCL_LIMIT_COMMANDS) {
- slavePtr->limit.active |= TCL_LIMIT_COMMANDS;
- slavePtr->limit.cmdCount = 0;
- slavePtr->limit.cmdGranularity = masterPtr->limit.cmdGranularity;
+ if (parentPtr->limit.active & TCL_LIMIT_COMMANDS) {
+ childPtr->limit.active |= TCL_LIMIT_COMMANDS;
+ childPtr->limit.cmdCount = 0;
+ childPtr->limit.cmdGranularity = parentPtr->limit.cmdGranularity;
}
- if (masterPtr->limit.active & TCL_LIMIT_TIME) {
- slavePtr->limit.active |= TCL_LIMIT_TIME;
- memcpy(&slavePtr->limit.time, &masterPtr->limit.time,
+ if (parentPtr->limit.active & TCL_LIMIT_TIME) {
+ childPtr->limit.active |= TCL_LIMIT_TIME;
+ memcpy(&childPtr->limit.time, &parentPtr->limit.time,
sizeof(Tcl_Time));
- slavePtr->limit.timeGranularity = masterPtr->limit.timeGranularity;
+ childPtr->limit.timeGranularity = parentPtr->limit.timeGranularity;
}
}
/*
*----------------------------------------------------------------------
*
- * SlaveCommandLimitCmd --
+ * ChildCommandLimitCmd --
*
* Implementation of the [interp limit $i commands] and [$i limit
* commands] subcommands. See the interp manual page for a full
@@ -4456,9 +4457,9 @@ InheritLimitsFromMaster(
*/
static int
-SlaveCommandLimitCmd(
+ChildCommandLimitCmd(
Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */
+ Tcl_Interp *childInterp, /* Interpreter being adjusted. */
int consumedObjc, /* Number of args already parsed. */
int objc, /* Total number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -4482,7 +4483,7 @@ SlaveCommandLimitCmd(
* avoid. [Bug 3398794]
*/
- if (interp == slaveInterp) {
+ if (interp == childInterp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"limits on current interpreter inaccessible", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
@@ -4493,7 +4494,7 @@ SlaveCommandLimitCmd(
Tcl_Obj *dictPtr;
TclNewObj(dictPtr);
- key.interp = slaveInterp;
+ key.interp = childInterp;
key.type = TCL_LIMIT_COMMANDS;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
@@ -4513,12 +4514,12 @@ SlaveCommandLimitCmd(
Tcl_NewStringObj(options[0], -1), empty);
}
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewWideIntObj(Tcl_LimitGetGranularity(slaveInterp,
+ Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp,
TCL_LIMIT_COMMANDS)));
- if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
+ if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewWideIntObj(Tcl_LimitGetCommands(slaveInterp)));
+ Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp)));
} else {
Tcl_Obj *empty;
@@ -4535,7 +4536,7 @@ SlaveCommandLimitCmd(
}
switch ((enum Options) index) {
case OPT_CMD:
- key.interp = slaveInterp;
+ key.interp = childInterp;
key.type = TCL_LIMIT_COMMANDS;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
@@ -4547,12 +4548,12 @@ SlaveCommandLimitCmd(
break;
case OPT_GRAN:
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_COMMANDS)));
+ Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS)));
break;
case OPT_VAL:
- if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
+ if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
Tcl_SetObjResult(interp,
- Tcl_NewWideIntObj(Tcl_LimitGetCommands(slaveInterp)));
+ Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp)));
}
break;
}
@@ -4608,18 +4609,18 @@ SlaveCommandLimitCmd(
}
}
if (scriptObj != NULL) {
- SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, slaveInterp,
+ SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, childInterp,
(scriptLen > 0 ? scriptObj : NULL));
}
if (granObj != NULL) {
- Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_COMMANDS, gran);
+ Tcl_LimitSetGranularity(childInterp, TCL_LIMIT_COMMANDS, gran);
}
if (limitObj != NULL) {
if (limitLen > 0) {
- Tcl_LimitSetCommands(slaveInterp, limit);
- Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_COMMANDS);
+ Tcl_LimitSetCommands(childInterp, limit);
+ Tcl_LimitTypeSet(childInterp, TCL_LIMIT_COMMANDS);
} else {
- Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_COMMANDS);
+ Tcl_LimitTypeReset(childInterp, TCL_LIMIT_COMMANDS);
}
}
return TCL_OK;
@@ -4629,7 +4630,7 @@ SlaveCommandLimitCmd(
/*
*----------------------------------------------------------------------
*
- * SlaveTimeLimitCmd --
+ * ChildTimeLimitCmd --
*
* Implementation of the [interp limit $i time] and [$i limit time]
* subcommands. See the interp manual page for a full description.
@@ -4644,9 +4645,9 @@ SlaveCommandLimitCmd(
*/
static int
-SlaveTimeLimitCmd(
+ChildTimeLimitCmd(
Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */
+ Tcl_Interp *childInterp, /* Interpreter being adjusted. */
int consumedObjc, /* Number of args already parsed. */
int objc, /* Total number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -4670,7 +4671,7 @@ SlaveTimeLimitCmd(
* avoid. [Bug 3398794]
*/
- if (interp == slaveInterp) {
+ if (interp == childInterp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"limits on current interpreter inaccessible", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
@@ -4681,7 +4682,7 @@ SlaveTimeLimitCmd(
Tcl_Obj *dictPtr;
TclNewObj(dictPtr);
- key.interp = slaveInterp;
+ key.interp = childInterp;
key.type = TCL_LIMIT_TIME;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
@@ -4700,13 +4701,13 @@ SlaveTimeLimitCmd(
Tcl_NewStringObj(options[0], -1), empty);
}
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewWideIntObj(Tcl_LimitGetGranularity(slaveInterp,
+ Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp,
TCL_LIMIT_TIME)));
- if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
+ if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
Tcl_Time limitMoment;
- Tcl_LimitGetTime(slaveInterp, &limitMoment);
+ Tcl_LimitGetTime(childInterp, &limitMoment);
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
Tcl_NewWideIntObj(limitMoment.usec/1000));
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1),
@@ -4729,7 +4730,7 @@ SlaveTimeLimitCmd(
}
switch ((enum Options) index) {
case OPT_CMD:
- key.interp = slaveInterp;
+ key.interp = childInterp;
key.type = TCL_LIMIT_TIME;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
@@ -4741,22 +4742,22 @@ SlaveTimeLimitCmd(
break;
case OPT_GRAN:
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_TIME)));
+ Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME)));
break;
case OPT_MILLI:
- if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
+ if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
Tcl_Time limitMoment;
- Tcl_LimitGetTime(slaveInterp, &limitMoment);
+ Tcl_LimitGetTime(childInterp, &limitMoment);
Tcl_SetObjResult(interp,
Tcl_NewWideIntObj(limitMoment.usec/1000));
}
break;
case OPT_SEC:
- if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
+ if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
Tcl_Time limitMoment;
- Tcl_LimitGetTime(slaveInterp, &limitMoment);
+ Tcl_LimitGetTime(childInterp, &limitMoment);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limitMoment.sec));
}
break;
@@ -4773,7 +4774,7 @@ SlaveTimeLimitCmd(
Tcl_Time limitMoment;
int tmp;
- Tcl_LimitGetTime(slaveInterp, &limitMoment);
+ Tcl_LimitGetTime(childInterp, &limitMoment);
for (i=consumedObjc ; i<objc ; i+=2) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&index) != TCL_OK) {
@@ -4870,18 +4871,18 @@ SlaveTimeLimitCmd(
limitMoment.sec += limitMoment.usec / 1000000;
limitMoment.usec %= 1000000;
- Tcl_LimitSetTime(slaveInterp, &limitMoment);
- Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_TIME);
+ Tcl_LimitSetTime(childInterp, &limitMoment);
+ Tcl_LimitTypeSet(childInterp, TCL_LIMIT_TIME);
} else {
- Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_TIME);
+ Tcl_LimitTypeReset(childInterp, TCL_LIMIT_TIME);
}
}
if (scriptObj != NULL) {
- SetScriptLimitCallback(interp, TCL_LIMIT_TIME, slaveInterp,
+ SetScriptLimitCallback(interp, TCL_LIMIT_TIME, childInterp,
(scriptLen > 0 ? scriptObj : NULL));
}
if (granObj != NULL) {
- Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_TIME, gran);
+ Tcl_LimitSetGranularity(childInterp, TCL_LIMIT_TIME, gran);
}
return TCL_OK;
}
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 95844a0..c763218 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -911,8 +911,8 @@ LinkTraceProc(
return (char *) "wrong size of char* value";
}
if (linkPtr->flags & LINK_ALLOC_LAST) {
- memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
- memcpy(linkPtr->addr, value, (size_t) valueLength);
+ memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
+ memcpy(linkPtr->addr, value, valueLength);
} else {
linkPtr->lastValue.c = '\0';
LinkedVar(char) = linkPtr->lastValue.c;
@@ -925,8 +925,8 @@ LinkTraceProc(
return (char *) "wrong size of binary value";
}
if (linkPtr->flags & LINK_ALLOC_LAST) {
- memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
- memcpy(linkPtr->addr, value, (size_t) valueLength);
+ memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
+ memcpy(linkPtr->addr, value, valueLength);
} else {
linkPtr->lastValue.uc = (unsigned char) *value;
LinkedVar(unsigned char) = linkPtr->lastValue.uc;
@@ -1296,7 +1296,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewIntObj(linkPtr->lastValue.iPtr[i]);
+ TclNewIntObj(objv[i], linkPtr->lastValue.iPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
ckfree(objv);
@@ -1348,7 +1348,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewIntObj(linkPtr->lastValue.cPtr[i]);
+ TclNewIntObj(objv[i], linkPtr->lastValue.cPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
ckfree(objv);
@@ -1361,7 +1361,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ucPtr[i]);
+ TclNewIntObj(objv[i], linkPtr->lastValue.ucPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
ckfree(objv);
@@ -1374,7 +1374,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewIntObj(linkPtr->lastValue.sPtr[i]);
+ TclNewIntObj(objv[i], linkPtr->lastValue.sPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
ckfree(objv);
@@ -1387,7 +1387,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewIntObj(linkPtr->lastValue.usPtr[i]);
+ TclNewIntObj(objv[i], linkPtr->lastValue.usPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
ckfree(objv);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 2877796..5a0d45f 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1091,7 +1091,7 @@ Tcl_ListObjReplace(
if ((numAfterLast > 0) && (shift != 0)) {
Tcl_Obj **src = elemPtrs + start;
- memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
+ memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*));
}
} else {
/*
@@ -1263,7 +1263,7 @@ TclLindexList(
ListGetIntRep(argPtr, listRepPtr);
if ((listRepPtr == NULL)
- && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
+ && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, &index) == TCL_OK) {
/*
* argPtr designates a single index.
*/
@@ -1373,7 +1373,7 @@ TclLindexFlat(
*/
while (++i < indexCount) {
- if (TclGetIntForIndexM(interp, indexArray[i], -1, &index)
+ if (TclGetIntForIndexM(interp, indexArray[i], INT_MAX - 1, &index)
!= TCL_OK) {
Tcl_DecrRefCount(sublistCopy);
return NULL;
@@ -1444,7 +1444,7 @@ TclLsetList(
ListGetIntRep(indexArgPtr, listRepPtr);
if (listRepPtr == NULL
- && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
+ && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) {
/*
* indexArgPtr designates a single index.
*/
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 738f65b..5fdc116 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -115,7 +115,7 @@ static void LoadCleanupProc(ClientData clientData,
int
Tcl_LoadObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -196,9 +196,9 @@ Tcl_LoadObjCmd(
target = interp;
if (objc == 4) {
- const char *slaveIntName = Tcl_GetString(objv[3]);
+ const char *childIntName = Tcl_GetString(objv[3]);
- target = Tcl_GetSlave(interp, slaveIntName);
+ target = Tcl_GetChild(interp, childIntName);
if (target == NULL) {
code = TCL_ERROR;
goto done;
@@ -542,7 +542,7 @@ Tcl_LoadObjCmd(
int
Tcl_UnloadObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -632,9 +632,9 @@ Tcl_UnloadObjCmd(
target = interp;
if (objc - i == 3) {
- const char *slaveIntName = Tcl_GetString(objv[i + 2]);
+ const char *childIntName = Tcl_GetString(objv[i + 2]);
- target = Tcl_GetSlave(interp, slaveIntName);
+ target = Tcl_GetChild(interp, childIntName);
if (target == NULL) {
return TCL_ERROR;
}
@@ -1087,7 +1087,7 @@ TclGetLoadedPackagesEx(
return TCL_OK;
}
- target = Tcl_GetSlave(interp, targetName);
+ target = Tcl_GetChild(interp, targetName);
if (target == NULL) {
return TCL_ERROR;
}
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 26dca62..8e138d0 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1770,6 +1770,8 @@ DoImport(
TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
+ /* corresponding decrement is in DeleteImportedCmd */
+ cmdPtr->refCount++;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
Tcl_DStringFree(&ds);
@@ -2077,6 +2079,7 @@ DeleteImportedCmd(
prevPtr->nextPtr = refPtr->nextPtr;
}
ckfree(refPtr);
+ TclCleanupCommandMacro(realCmdPtr);
ckfree(dataPtr);
return;
}
@@ -3888,7 +3891,7 @@ NamespaceOriginCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Command command, origCommand;
+ Tcl_Command cmd, origCmd;
Tcl_Obj *resultPtr;
if (objc != 2) {
@@ -3896,30 +3899,29 @@ NamespaceOriginCmd(
return TCL_ERROR;
}
- command = Tcl_GetCommandFromObj(interp, objv[1]);
- if (command == NULL) {
+ cmd = Tcl_GetCommandFromObj(interp, objv[1]);
+ if (cmd == NULL) {
+ goto namespaceOriginError;
+ }
+ origCmd = TclGetOriginalCommand(cmd);
+ if (origCmd == NULL) {
+ origCmd = cmd;
+ }
+ TclNewObj(resultPtr);
+ Tcl_GetCommandFullName(interp, origCmd, resultPtr);
+ if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES ) {
+ Tcl_DecrRefCount(resultPtr);
+ namespaceOriginError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid command name \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
- origCommand = TclGetOriginalCommand(command);
- TclNewObj(resultPtr);
- if (origCommand == NULL) {
- /*
- * The specified command isn't an imported command. Return the
- * command's name qualified by the full name of the namespace it was
- * defined in.
- */
-
- Tcl_GetCommandFullName(interp, command, resultPtr);
- } else {
- Tcl_GetCommandFullName(interp, origCommand, resultPtr);
- }
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
+
/*
*----------------------------------------------------------------------
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 322daff..21018ac 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -133,7 +133,7 @@ static const Tcl_MethodType classConstructor = {
};
/*
- * Scripted parts of TclOO. First, the master script (cannot be outside this
+ * Scripted parts of TclOO. First, the main script (cannot be outside this
* file).
*/
@@ -258,7 +258,7 @@ TclOOInit(
}
return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
- (ClientData) &tclOOStubs);
+ (void *) &tclOOStubs);
}
/*
@@ -566,7 +566,7 @@ DeletedHelpersNamespace(
static void
KillFoundation(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp) /* The interpreter containing the OO system
* foundation. */
{
@@ -1177,7 +1177,7 @@ ObjectNamespaceDeleted(
* freed memory.
*/
- if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
+ if (((Command *) oPtr->command)->flags && CMD_DYING) {
/*
* Something has already started the command deletion process. We can
* go ahead and clean up the the namespace,
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 9f7b526..b866c2c 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -1249,7 +1249,7 @@ TclOOSelfObjCmd(
}
case SELF_CALL:
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
- result[1] = Tcl_NewIntObj(contextPtr->index);
+ TclNewIntObj(result[1], contextPtr->index);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 3758d55..a555d1b 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -114,7 +114,7 @@ TclOOInitInfo(
TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);
/*
- * Install into the master [info] ensemble.
+ * Install into the [info] ensemble.
*/
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
@@ -171,7 +171,7 @@ GetClassFromObj(
static int
InfoObjectClassCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -228,7 +228,7 @@ InfoObjectClassCmd(
static int
InfoObjectDefnCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -302,7 +302,7 @@ InfoObjectDefnCmd(
static int
InfoObjectFiltersCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -341,7 +341,7 @@ InfoObjectFiltersCmd(
static int
InfoObjectForwardCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -398,7 +398,7 @@ InfoObjectForwardCmd(
static int
InfoObjectIsACmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -517,7 +517,7 @@ InfoObjectIsACmd(
static int
InfoObjectMethodsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -637,7 +637,7 @@ InfoObjectMethodsCmd(
static int
InfoObjectMethodTypeCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -694,7 +694,7 @@ InfoObjectMethodTypeCmd(
static int
InfoObjectMixinsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -737,7 +737,7 @@ InfoObjectMixinsCmd(
static int
InfoObjectIdCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -769,7 +769,7 @@ InfoObjectIdCmd(
static int
InfoObjectNsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -802,7 +802,7 @@ InfoObjectNsCmd(
static int
InfoObjectVariablesCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -856,7 +856,7 @@ InfoObjectVariablesCmd(
static int
InfoObjectVarsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -917,7 +917,7 @@ InfoObjectVarsCmd(
static int
InfoClassConstrCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -978,7 +978,7 @@ InfoClassConstrCmd(
static int
InfoClassDefnCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1046,7 +1046,7 @@ InfoClassDefnCmd(
static int
InfoClassDefnNsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1096,7 +1096,7 @@ InfoClassDefnNsCmd(
static int
InfoClassDestrCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1140,7 +1140,7 @@ InfoClassDestrCmd(
static int
InfoClassFiltersCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1178,7 +1178,7 @@ InfoClassFiltersCmd(
static int
InfoClassForwardCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1229,7 +1229,7 @@ InfoClassForwardCmd(
static int
InfoClassInstancesCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1277,7 +1277,7 @@ InfoClassInstancesCmd(
static int
InfoClassMethodsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1393,7 +1393,7 @@ InfoClassMethodsCmd(
static int
InfoClassMethodTypeCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1445,7 +1445,7 @@ InfoClassMethodTypeCmd(
static int
InfoClassMixinsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1487,7 +1487,7 @@ InfoClassMixinsCmd(
static int
InfoClassSubsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1542,7 +1542,7 @@ InfoClassSubsCmd(
static int
InfoClassSupersCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1581,7 +1581,7 @@ InfoClassSupersCmd(
static int
InfoClassVariablesCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1635,7 +1635,7 @@ InfoClassVariablesCmd(
static int
InfoObjectCallCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1681,7 +1681,7 @@ InfoObjectCallCmd(
static int
InfoClassCallCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index db4b7f1..007cbfd 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -329,7 +329,7 @@ typedef struct Class {
*/
typedef struct ThreadLocalData {
- int nsCount; /* Master epoch counter is used for keeping
+ int nsCount; /* Epoch counter is used for keeping
* the values used in Tcl_Obj internal
* representations sane. Must be thread-local
* because Tcl_Objs can cross interpreter
@@ -341,7 +341,7 @@ typedef struct Foundation {
Tcl_Interp *interp;
Class *objectCls; /* The root of the object system. */
Class *classCls; /* The class of all classes. */
- Tcl_Namespace *ooNs; /* Master ::oo namespace. */
+ Tcl_Namespace *ooNs; /* ::oo namespace. */
Tcl_Namespace *defineNs; /* Namespace containing special commands for
* manipulating objects and classes. The
* "oo::define" command acts as a special kind
diff --git a/generic/tclObj.c b/generic/tclObj.c
index dbe6686..e58206b 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -145,12 +145,12 @@ typedef struct PendingObjData {
#define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--)
#define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0)
#define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL)
-#define PushObjToDelete(contextPtr,objPtr) \
+#define PushObjToDelete(contextPtr,objPtr) \
/* The string rep is already invalidated so we can use the bytes value \
* for our pointer chain: push onto the head of the stack. */ \
(objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
(contextPtr)->deletionStack = (objPtr)
-#define PopObjToDelete(contextPtr,objPtrVar) \
+#define PopObjToDelete(contextPtr,objPtrVar) \
(objPtrVar) = (contextPtr)->deletionStack; \
(contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
@@ -168,7 +168,7 @@ static __thread PendingObjData pendingObjData;
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
- PendingObjData *const contextPtr = \
+ PendingObjData *const contextPtr = \
(PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif
@@ -177,15 +177,15 @@ static Tcl_ThreadDataKey pendingObjDataKey;
*/
#define PACK_BIGNUM(bignum, objPtr) \
- if ((bignum).used > 0x7FFF) { \
- mp_int *temp = (mp_int *) ckalloc(sizeof(mp_int)); \
+ if ((bignum).used > 0x7FFF) { \
+ mp_int *temp = (mp_int *)ckalloc(sizeof(mp_int)); \
*temp = bignum; \
- (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
- (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
} else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
- (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
- | ((bignum).alloc << 15) | ((bignum).used)); \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \
+ | ((bignum).alloc << 15) | ((bignum).used)); \
}
/*
@@ -567,7 +567,7 @@ TclContinuationsEnter(
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
- ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
+ ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int));
if (!newEntry) {
/*
@@ -4667,7 +4667,7 @@ SetCmdNameFromAny(
* report the failure to find the command as an error.
*/
- if (cmdPtr == NULL) {
+ if (cmdPtr == NULL || !TclRoutineHasName(cmdPtr)) {
return TCL_ERROR;
}
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 095e6c5..4383c62 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -34,7 +34,7 @@ static void TrimUnreachable(CompileEnv *envPtr);
#define AddrLength(address) \
(tclInstructionTable[*(unsigned char *)(address)].numBytes)
#define InstLength(instruction) \
- (tclInstructionTable[(unsigned char)(instruction)].numBytes)
+ (tclInstructionTable[UCHAR(instruction)].numBytes)
/*
* ----------------------------------------------------------------------
diff --git a/generic/tclParse.c b/generic/tclParse.c
index e95768d..86ce1d0 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -220,6 +220,10 @@ Tcl_ParseCommand(
* point to char after terminating one. */
int scanned;
+ if (numBytes < 0 && start) {
+ numBytes = strlen(start);
+ }
+ TclParseInit(interp, start, numBytes, parsePtr);
if ((start == NULL) && (numBytes != 0)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -227,10 +231,6 @@ Tcl_ParseCommand(
}
return TCL_ERROR;
}
- if (numBytes < 0) {
- numBytes = strlen(start);
- }
- TclParseInit(interp, start, numBytes, parsePtr);
parsePtr->commentStart = NULL;
parsePtr->commentSize = 0;
parsePtr->commandStart = NULL;
@@ -858,7 +858,7 @@ TclParseBackslash(
/*
* Keep only the last byte (2 hex digits).
*/
- result = (unsigned char) result;
+ result = UCHAR(result);
}
break;
case 'u':
@@ -868,13 +868,13 @@ TclParseBackslash(
* No hexdigits -> This is just "u".
*/
result = 'u';
- } else if (((result & 0xDC00) == 0xD800) && (count == 6)
+ } else if (((result & 0xFC00) == 0xD800) && (count == 6)
&& (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
/* If high surrogate is immediately followed by a low surrogate
* escape, combine them into one character. */
int low;
int count2 = ParseHex(p+7, 4, &low);
- if ((count2 == 4) && ((low & 0xDC00) == 0xDC00)) {
+ if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
count += count2 + 2;
}
@@ -1347,16 +1347,15 @@ Tcl_ParseVarName(
int varIndex;
unsigned array;
- if ((numBytes == 0) || (start == NULL)) {
- return TCL_ERROR;
- }
- if (numBytes < 0) {
+ if (numBytes < 0 && start) {
numBytes = strlen(start);
}
-
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
+ if ((numBytes == 0) || (start == NULL)) {
+ return TCL_ERROR;
+ }
/*
* Generate one token for the variable, an additional token for the name,
@@ -1629,16 +1628,15 @@ Tcl_ParseBraces(
const char *src;
int startIndex, level, length;
- if ((numBytes == 0) || (start == NULL)) {
- return TCL_ERROR;
- }
- if (numBytes < 0) {
+ if (numBytes < 0 && start) {
numBytes = strlen(start);
}
-
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
+ if ((numBytes == 0) || (start == NULL)) {
+ return TCL_ERROR;
+ }
src = start;
startIndex = parsePtr->numTokens;
@@ -1827,16 +1825,15 @@ Tcl_ParseQuotedString(
* the quoted string's terminating close-quote
* if the parse succeeds. */
{
- if ((numBytes == 0) || (start == NULL)) {
- return TCL_ERROR;
- }
- if (numBytes < 0) {
+ if (numBytes < 0 && start) {
numBytes = strlen(start);
}
-
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
+ if ((numBytes == 0) || (start == NULL)) {
+ return TCL_ERROR;
+ }
if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
parsePtr)) {
@@ -2107,7 +2104,7 @@ TclSubstTokens(
* command, which is refered to by 'script'.
* The 'clNextOuter' refers to the current
* entry in the table of continuation lines in
- * this "master script", and the character
+ * this "main script", and the character
* offsets are relative to the 'outerScript'
* as well.
*
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index b39224e..bdd9a86 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -905,8 +905,9 @@ SelectPackageFinal(
}
}
} else if (result != TCL_ERROR) {
- Tcl_Obj *codePtr = Tcl_NewIntObj(result);
+ Tcl_Obj *codePtr;
+ TclNewIntObj(codePtr, result);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" bad return code: %s",
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 5a1b589..67c8c41 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -544,7 +544,7 @@ TclCreateProc(
*/
argnamei = argname;
- argnamelast = Tcl_UtfPrev(argname + nameLength, argname);
+ argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname;
while (argnamei < argnamelast) {
if (*argnamei == '(') {
if (*argnamelast == ')') { /* We have an array element. */
@@ -565,7 +565,7 @@ TclCreateProc(
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
- argnamei = Tcl_UtfNext(argnamei);
+ argnamei++;
}
if (precompiled) {
@@ -632,7 +632,8 @@ TclCreateProc(
* local variables for the argument.
*/
- localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1);
+ localPtr = (CompiledLocal *)ckalloc(
+ offsetof(CompiledLocal, name) + fieldValues[0]->length + 1);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -1313,8 +1314,8 @@ InitLocalCache(
* for future calls.
*/
- localCachePtr = (LocalCache *)ckalloc(sizeof(LocalCache)
- + (localCt - 1) * sizeof(Tcl_Obj *)
+ localCachePtr = (LocalCache *)ckalloc(offsetof(LocalCache, varName0)
+ + localCt * sizeof(Tcl_Obj *)
+ numArgs * sizeof(Var));
namePtr = &localCachePtr->varName0;
diff --git a/generic/tclProcess.c b/generic/tclProcess.c
index 5bf0af8..c0f21e3 100644
--- a/generic/tclProcess.c
+++ b/generic/tclProcess.c
@@ -267,8 +267,8 @@ WaitProcessStatus(
"child process exited abnormally", -1);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
- errorStrings[1] = Tcl_NewIntObj(resolvedPid);
- errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus));
+ TclNewIntObj(errorStrings[1], resolvedPid);
+ TclNewIntObj(errorStrings[2], WEXITSTATUS(waitStatus));
*errorObjPtr = Tcl_NewListObj(3, errorStrings);
}
}
@@ -286,7 +286,7 @@ WaitProcessStatus(
"child killed: %s", msg);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
- errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+ TclNewIntObj(errorStrings[1], resolvedPid);
errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
errorStrings[3] = Tcl_NewStringObj(msg, -1);
*errorObjPtr = Tcl_NewListObj(4, errorStrings);
@@ -305,7 +305,7 @@ WaitProcessStatus(
"child suspended: %s", msg);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
- errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+ TclNewIntObj(errorStrings[1], resolvedPid);
errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
errorStrings[3] = Tcl_NewStringObj(msg, -1);
*errorObjPtr = Tcl_NewListObj(4, errorStrings);
@@ -326,7 +326,7 @@ WaitProcessStatus(
errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
- errorStrings[4] = Tcl_NewIntObj(resolvedPid);
+ TclNewIntObj(errorStrings[4], resolvedPid);
*errorObjPtr = Tcl_NewListObj(5, errorStrings);
}
return TCL_PROCESS_UNKNOWN_STATUS;
@@ -378,7 +378,7 @@ BuildProcessStatusObj(
* Abnormal exit, return {TCL_ERROR msg error}
*/
- resultObjs[0] = Tcl_NewIntObj(TCL_ERROR);
+ TclNewIntObj(resultObjs[0], TCL_ERROR);
resultObjs[1] = info->msg;
resultObjs[2] = info->error;
return Tcl_NewListObj(3, resultObjs);
diff --git a/generic/tclScan.c b/generic/tclScan.c
index dc98f54..4d86382 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -896,7 +896,7 @@ Tcl_ScanObjCmd(
width = ~0;
}
if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
- &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
+ &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
Tcl_DecrRefCount(objPtr);
if (width < 0) {
if (*end == '\0') {
@@ -998,7 +998,7 @@ Tcl_ScanObjCmd(
width = ~0;
}
if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
- &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
+ &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) {
Tcl_DecrRefCount(objPtr);
if (width < 0) {
if (*end == '\0') {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 7ef2c60..6444823 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -535,6 +535,8 @@ TclParseNumber(
int shift = 0; /* Amount to shift when accumulating binary */
int explicitOctal = 0;
mp_err err = MP_OKAY;
+ int under = 0; /* Flag trailing '_' as error if true once
+ * number is accepted. */
#define ALL_BITS ((Tcl_WideUInt)-1)
#define MOST_BITS (ALL_BITS >> 1)
@@ -643,7 +645,7 @@ TclParseNumber(
acceptPoint = p;
acceptLen = len;
if (c == 'x' || c == 'X') {
- if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) {
+ if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY) || under) {
goto endgame;
}
state = ZERO_X;
@@ -656,7 +658,7 @@ TclParseNumber(
goto zeroo;
}
if (c == 'b' || c == 'B') {
- if (flags & TCL_PARSE_OCTAL_ONLY) {
+ if ((flags & TCL_PARSE_OCTAL_ONLY) || under) {
goto endgame;
}
state = ZERO_B;
@@ -666,11 +668,17 @@ TclParseNumber(
goto zerob;
}
if (c == 'o' || c == 'O') {
+ if (under) {
+ goto endgame;
+ }
explicitOctal = 1;
state = ZERO_O;
break;
}
if (c == 'd' || c == 'D') {
+ if (under) {
+ goto endgame;
+ }
state = ZERO_D;
break;
}
@@ -694,9 +702,11 @@ TclParseNumber(
zeroo:
if (c == '0') {
numTrailZeros++;
+ under = 0;
state = OCTAL;
break;
} else if (c >= '1' && c <= '7') {
+ under = 0;
if (objPtr != NULL) {
shift = 3 * (numTrailZeros + 1);
significandOverflow = AccumulateDecimalDigit(
@@ -746,6 +756,10 @@ TclParseNumber(
numTrailZeros = 0;
state = OCTAL;
break;
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
}
/* FALLTHROUGH */
@@ -774,6 +788,7 @@ TclParseNumber(
if (c == '0') {
numTrailZeros++;
+ under = 0;
state = BAD_OCTAL;
break;
} else if (isdigit(UCHAR(c))) {
@@ -789,12 +804,15 @@ TclParseNumber(
numSigDigs = 1;
}
numTrailZeros = 0;
+ under = 0;
state = BAD_OCTAL;
break;
} else if (c == '.') {
+ under = 0;
state = FRACTION;
break;
} else if (c == 'E' || c == 'e') {
+ under = 0;
state = EXPONENT_START;
break;
}
@@ -817,14 +835,22 @@ TclParseNumber(
zerox:
if (c == '0') {
numTrailZeros++;
+ under = 0;
state = HEXADECIMAL;
break;
} else if (isdigit(UCHAR(c))) {
+ under = 0;
d = (c-'0');
} else if (c >= 'A' && c <= 'F') {
+ under = 0;
d = (c-'A'+10);
} else if (c >= 'a' && c <= 'f') {
+ under = 0;
d = (c-'a'+10);
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
} else {
goto endgame;
}
@@ -870,8 +896,13 @@ TclParseNumber(
zerob:
if (c == '0') {
numTrailZeros++;
+ under = 0;
state = BINARY;
break;
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
} else if (c != '1') {
goto endgame;
}
@@ -910,10 +941,17 @@ TclParseNumber(
case ZERO_D:
if (c == '0') {
+ under = 0;
numTrailZeros++;
} else if ( ! isdigit(UCHAR(c))) {
+ if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
+ }
goto endgame;
}
+ under = 0;
state = DECIMAL;
flags |= TCL_PARSE_INTEGER_ONLY;
/* FALLTHROUGH */
@@ -932,6 +970,7 @@ TclParseNumber(
acceptLen = len;
if (c == '0') {
numTrailZeros++;
+ under = 0;
state = DECIMAL;
break;
} else if (isdigit(UCHAR(c))) {
@@ -943,14 +982,21 @@ TclParseNumber(
}
numSigDigs += numTrailZeros+1;
numTrailZeros = 0;
+ under = 0;
state = DECIMAL;
break;
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
} else if (flags & TCL_PARSE_INTEGER_ONLY) {
goto endgame;
} else if (c == '.') {
+ under = 0;
state = FRACTION;
break;
} else if (c == 'E' || c == 'e') {
+ under = 0;
state = EXPONENT_START;
break;
}
@@ -976,6 +1022,7 @@ TclParseNumber(
if (c == '0') {
numDigitsAfterDp++;
numTrailZeros++;
+ under = 0;
state = FRACTION;
break;
} else if (isdigit(UCHAR(c))) {
@@ -992,8 +1039,13 @@ TclParseNumber(
numSigDigs = 1;
}
numTrailZeros = 0;
+ under = 0;
state = FRACTION;
break;
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
}
goto endgame;
@@ -1005,10 +1057,12 @@ TclParseNumber(
*/
if (c == '+') {
+ under = 0;
state = EXPONENT_SIGNUM;
break;
} else if (c == '-') {
exponentSignum = 1;
+ under = 0;
state = EXPONENT_SIGNUM;
break;
}
@@ -1022,8 +1076,13 @@ TclParseNumber(
if (isdigit(UCHAR(c))) {
exponent = c - '0';
+ under = 0;
state = EXPONENT;
break;
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
}
goto endgame;
@@ -1042,8 +1101,13 @@ TclParseNumber(
} else {
exponent = LONG_MAX;
}
+ under = 0;
state = EXPONENT;
break;
+ } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+ /* Ignore numeric "white space" */
+ under = 1;
+ break;
}
goto endgame;
@@ -1054,12 +1118,14 @@ TclParseNumber(
case sI:
if (c == 'n' || c == 'N') {
+ under = 0;
state = sIN;
break;
}
goto endgame;
case sIN:
if (c == 'f' || c == 'F') {
+ under = 0;
state = sINF;
break;
}
@@ -1068,6 +1134,7 @@ TclParseNumber(
acceptState = state;
acceptPoint = p;
acceptLen = len;
+ under = 0;
if (c == 'i' || c == 'I') {
state = sINFI;
break;
@@ -1075,24 +1142,28 @@ TclParseNumber(
goto endgame;
case sINFI:
if (c == 'n' || c == 'N') {
+ under = 0;
state = sINFIN;
break;
}
goto endgame;
case sINFIN:
if (c == 'i' || c == 'I') {
+ under = 0;
state = sINFINI;
break;
}
goto endgame;
case sINFINI:
if (c == 't' || c == 'T') {
+ under = 0;
state = sINFINIT;
break;
}
goto endgame;
case sINFINIT:
if (c == 'y' || c == 'Y') {
+ under = 0;
state = sINFINITY;
break;
}
@@ -1104,12 +1175,14 @@ TclParseNumber(
#ifdef IEEE_FLOATING_POINT
case sN:
if (c == 'a' || c == 'A') {
+ under = 0;
state = sNA;
break;
}
goto endgame;
case sNA:
if (c == 'n' || c == 'N') {
+ under = 0;
state = sNAN;
break;
}
@@ -1119,6 +1192,7 @@ TclParseNumber(
acceptPoint = p;
acceptLen = len;
if (c == '(') {
+ under = 0;
state = sNANPAREN;
break;
}
@@ -1129,12 +1203,14 @@ TclParseNumber(
*/
case sNANHEX:
if (c == ')') {
+ under = 0;
state = sNANFINISH;
break;
}
/* FALLTHROUGH */
case sNANPAREN:
if (TclIsSpaceProcM(c)) {
+ under = 0;
break;
}
if (numSigDigs < 13) {
@@ -1149,6 +1225,7 @@ TclParseNumber(
}
numSigDigs++;
significandWide = (significandWide << 4) + d;
+ under = 0;
state = sNANHEX;
break;
}
@@ -1161,6 +1238,7 @@ TclParseNumber(
acceptPoint = p;
acceptLen = len;
goto endgame;
+
}
p++;
len--;
@@ -1179,10 +1257,13 @@ TclParseNumber(
} else {
/*
* Back up to the last accepting state in the lexer.
+ * If the last char seen is the numeric whitespace character '_',
+ * backup to that.
*/
- p = acceptPoint;
- len = acceptLen;
+ p = under ? acceptPoint-1 : acceptPoint;
+ len = under ? acceptLen-1 : acceptLen;
+
if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
/*
* Accept trailing whitespace.
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 78e49f9..81c5c92 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3523,7 +3523,7 @@ TclStringCmp(
* length only.
*/
- match = memCmpFn(s1, s2, (size_t) length);
+ match = memCmpFn(s1, s2, length);
}
if ((match == 0) && (reqlength > length)) {
match = s1len - s2len;
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
index fc5a713..e01ba2d 100644
--- a/generic/tclStringRep.h
+++ b/generic/tclStringRep.h
@@ -59,15 +59,15 @@ typedef struct {
* space allocated for the unicode array. */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
- Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
+ Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
* of this field depends on the 'maxChars'
* field above. */
} String;
#define STRING_MAXCHARS \
- (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
+ (int)(((size_t)UINT_MAX - 1 - offsetof(String, unicode))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
- (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
+ (offsetof(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 5529e7e..b6eb9da 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -319,7 +319,7 @@ mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
if (maxlen < 0) {
return MP_VAL;
}
- return TclBN_mp_to_radix(a, str, (size_t)maxlen, NULL, radix);
+ return TclBN_mp_to_radix(a, str, maxlen, NULL, radix);
}
#define TclSetStartupScriptPath setStartupScriptPath
@@ -974,7 +974,7 @@ static const TclIntStubs tclIntStubs = {
TclResetRewriteEnsemble, /* 247 */
TclCopyChannel, /* 248 */
TclDoubleDigits, /* 249 */
- TclSetSlaveCancelFlags, /* 250 */
+ TclSetChildCancelFlags, /* 250 */
TclRegisterLiteral, /* 251 */
TclPtrGetVar, /* 252 */
TclPtrSetVar, /* 253 */
@@ -1311,7 +1311,7 @@ const TclStubs tclStubs = {
Tcl_CreateInterp, /* 94 */
Tcl_CreateMathFunc, /* 95 */
Tcl_CreateObjCommand, /* 96 */
- Tcl_CreateSlave, /* 97 */
+ Tcl_CreateChild, /* 97 */
Tcl_CreateTimerHandler, /* 98 */
Tcl_CreateTrace, /* 99 */
Tcl_DeleteAssocData, /* 100 */
@@ -1378,7 +1378,7 @@ const TclStubs tclStubs = {
Tcl_GetErrno, /* 161 */
Tcl_GetHostName, /* 162 */
Tcl_GetInterpPath, /* 163 */
- Tcl_GetMaster, /* 164 */
+ Tcl_GetParent, /* 164 */
Tcl_GetNameOfExecutable, /* 165 */
Tcl_GetObjResult, /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
@@ -1394,7 +1394,7 @@ const TclStubs tclStubs = {
Tcl_Gets, /* 169 */
Tcl_GetsObj, /* 170 */
Tcl_GetServiceMode, /* 171 */
- Tcl_GetSlave, /* 172 */
+ Tcl_GetChild, /* 172 */
Tcl_GetStdChannel, /* 173 */
Tcl_GetStringResult, /* 174 */
Tcl_GetVar, /* 175 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 499ef93..91d486e 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -20,7 +20,11 @@
# define USE_TCL_STUBS
#endif
#include "tclInt.h"
-#include "tclTomMath.h"
+#ifdef TCL_WITH_EXTERNAL_TOMMATH
+# include "tommath.h"
+#else
+# include "tclTomMath.h"
+#endif
#include "tclOO.h"
#include <math.h>
@@ -308,7 +312,7 @@ static Tcl_FSNormalizePathProc TestReportNormalizePath;
static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
-
+static Tcl_CmdProc TestServiceModeCmd;
static Tcl_FSStatProc SimpleStat;
static Tcl_FSAccessProc SimpleAccess;
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
@@ -446,9 +450,11 @@ Tcltest_Init(
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
+#ifndef TCL_WITH_EXTERNAL_TOMMATH
if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) {
return TCL_ERROR;
}
+#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
@@ -567,6 +573,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
NULL, NULL);
+ Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
@@ -719,7 +727,7 @@ Tcltest_SafeInit(
static int
TestasyncCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -929,7 +937,7 @@ AsyncThreadProc(
static int
TestbumpinterpepochObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -964,7 +972,7 @@ TestbumpinterpepochObjCmd(
static int
TestcmdinfoCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1091,7 +1099,7 @@ CmdDelProc2(
static int
TestcmdtokenCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1154,7 +1162,7 @@ TestcmdtokenCmd(
static int
TestcmdtraceCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1251,7 +1259,7 @@ CmdTraceProc(
char *command, /* The command being traced (after
* substitutions). */
TCL_UNUSED(Tcl_CmdProc *) /*cmdProc*/,
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int argc, /* Number of arguments. */
const char *argv[]) /* Argument strings. */
{
@@ -1269,12 +1277,12 @@ CmdTraceProc(
static void
CmdTraceDeleteProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*level*/,
TCL_UNUSED(char *) /*command*/,
TCL_UNUSED(Tcl_CmdProc *),
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
{
@@ -1289,7 +1297,7 @@ CmdTraceDeleteProc(
static int
ObjTraceProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
TCL_UNUSED(int) /*level*/,
const char *command,
@@ -1346,7 +1354,7 @@ ObjTraceDeleteProc(
static int
TestcreatecommandCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1376,7 +1384,7 @@ TestcreatecommandCmd(
static int
CreatedCommandProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
@@ -1398,7 +1406,7 @@ CreatedCommandProc(
static int
CreatedCommandProc2(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
@@ -1436,7 +1444,7 @@ CreatedCommandProc2(
static int
TestdcallCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1500,21 +1508,21 @@ DelCallbackProc(
static int
TestdelCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
DelCmd *dPtr;
- Tcl_Interp *slave;
+ Tcl_Interp *child;
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
- slave = Tcl_GetSlave(interp, argv[1]);
- if (slave == NULL) {
+ child = Tcl_GetChild(interp, argv[1]);
+ if (child == NULL) {
return TCL_ERROR;
}
@@ -1523,7 +1531,7 @@ TestdelCmd(
dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
strcpy(dPtr->deleteCmd, argv[3]);
- Tcl_CreateCommand(slave, argv[2], DelCmdProc, dPtr,
+ Tcl_CreateCommand(child, argv[2], DelCmdProc, dPtr,
DelDeleteProc);
return TCL_OK;
}
@@ -1575,7 +1583,7 @@ DelDeleteProc(
static int
TestdelassocdataCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1612,7 +1620,7 @@ TestdelassocdataCmd(
static int
TestdoubledigitsObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj* const objv[]) /* Parameter vector */
@@ -1699,7 +1707,7 @@ TestdoubledigitsObjCmd(
static int
TestdstringCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1825,7 +1833,7 @@ static void SpecialFree(
static int
TestencodingObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1985,7 +1993,7 @@ EncodingFreeProc(
static int
TestevalexObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2030,7 +2038,7 @@ TestevalexObjCmd(
static int
TestevalobjvObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2079,7 +2087,7 @@ TestevalobjvObjCmd(
static int
TesteventObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter vector */
@@ -2258,7 +2266,7 @@ TesteventDeleteProc(
static int
TestexithandlerCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2334,7 +2342,7 @@ ExitProcEven(
static int
TestexprlongCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2377,7 +2385,7 @@ TestexprlongCmd(
static int
TestexprlongobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
@@ -2419,7 +2427,7 @@ TestexprlongobjCmd(
static int
TestexprdoubleCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2463,7 +2471,7 @@ TestexprdoubleCmd(
static int
TestexprdoubleobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
@@ -2505,7 +2513,7 @@ TestexprdoubleobjCmd(
static int
TestexprstringCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2537,7 +2545,7 @@ TestexprstringCmd(
static int
TestfilelinkCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -2604,7 +2612,7 @@ TestfilelinkCmd(
static int
TestgetassocdataCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2642,7 +2650,7 @@ TestgetassocdataCmd(
static int
TestgetplatformCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2682,23 +2690,23 @@ TestgetplatformCmd(
static int
TestinterpdeleteCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
- Tcl_Interp *slaveToDelete;
+ Tcl_Interp *childToDelete;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" path\"", NULL);
return TCL_ERROR;
}
- slaveToDelete = Tcl_GetSlave(interp, argv[1]);
- if (slaveToDelete == NULL) {
+ childToDelete = Tcl_GetChild(interp, argv[1]);
+ if (childToDelete == NULL) {
return TCL_ERROR;
}
- Tcl_DeleteInterp(slaveToDelete);
+ Tcl_DeleteInterp(childToDelete);
return TCL_OK;
}
@@ -2722,7 +2730,7 @@ TestinterpdeleteCmd(
static int
TestlinkCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -3190,7 +3198,7 @@ TestlinkCmd(
static int
TestlinkarrayCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -3308,7 +3316,7 @@ TestlinkarrayCmd(
static int
TestlocaleCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3394,7 +3402,7 @@ CleanupTestSetassocdataTests(
static int
TestparserObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3450,7 +3458,7 @@ TestparserObjCmd(
static int
TestexprparserObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3597,7 +3605,7 @@ PrintParse(
static int
TestparsevarObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3638,7 +3646,7 @@ TestparsevarObjCmd(
static int
TestparsevarnameObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3701,7 +3709,7 @@ TestparsevarnameObjCmd(
static int
TestpreferstableObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
@@ -3731,7 +3739,7 @@ TestpreferstableObjCmd(
static int
TestprintObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3772,7 +3780,7 @@ TestprintObjCmd(
static int
TestregexpObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -4095,7 +4103,7 @@ TestregexpXflags(
static int
TestreturnObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
@@ -4123,7 +4131,7 @@ TestreturnObjCmd(
static int
TestsetassocdataCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4174,7 +4182,7 @@ TestsetassocdataCmd(
static int
TestsetplatformCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4223,7 +4231,7 @@ TestsetplatformCmd(
static int
TeststaticpkgCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4274,7 +4282,7 @@ StaticInitProc(
static int
TesttranslatefilenameCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4315,7 +4323,7 @@ TesttranslatefilenameCmd(
static int
TestupvarCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4367,7 +4375,7 @@ TestupvarCmd(
static int
TestseterrorcodeCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4419,7 +4427,7 @@ TestseterrorcodeCmd(
static int
TestsetobjerrorcodeCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4447,7 +4455,7 @@ TestsetobjerrorcodeCmd(
static int
TestfeventCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4519,7 +4527,7 @@ TestfeventCmd(
static int
TestpanicCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4538,7 +4546,7 @@ TestpanicCmd(
static int
TestfileCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
Tcl_Obj *const argv[]) /* The argument objects. */
@@ -4620,7 +4628,7 @@ TestfileCmd(
static int
TestgetvarfullnameCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4694,7 +4702,7 @@ TestgetvarfullnameCmd(
static int
GetTimesObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* The current interpreter. */
TCL_UNUSED(int) /*cobjc*/,
TCL_UNUSED(Tcl_Obj *const *) /*cobjv*/)
@@ -4873,7 +4881,7 @@ GetTimesObjCmd(
static int
NoopCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
@@ -4900,7 +4908,7 @@ NoopCmd(
static int
NoopObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
@@ -4925,7 +4933,7 @@ NoopObjCmd(
static int
TeststringbytesObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4965,7 +4973,7 @@ TeststringbytesObjCmd(
static int
TestpurebytesobjObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -5012,7 +5020,7 @@ TestpurebytesobjObjCmd(
static int
TestsetbytearraylengthObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -5056,7 +5064,7 @@ TestsetbytearraylengthObjCmd(
static int
TestbytestringObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -5178,7 +5186,7 @@ Testset2Cmd(
static int
TestsaveresultCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,/* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -5309,7 +5317,7 @@ TestsaveresultFree(
static int
TestmainthreadCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,/* Current interpreter. */
int argc, /* Number of arguments. */
TCL_UNUSED(const char **) /*argv*/)
@@ -5370,7 +5378,7 @@ MainLoop(void)
static int
TestsetmainloopCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
@@ -5399,7 +5407,7 @@ TestsetmainloopCmd(
static int
TestexitmainloopCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
@@ -5427,7 +5435,7 @@ TestexitmainloopCmd(
static int
TestChannelCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for result. */
int argc, /* Count of additional args. */
const char **argv) /* Additional arg strings. */
@@ -5894,7 +5902,7 @@ TestChannelCmd(
static int
TestChannelEventCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -6106,7 +6114,7 @@ TestChannelEventCmd(
static int
TestSocketCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for result. */
int argc, /* Count of additional args. */
const char **argv) /* Additional arg strings. */
@@ -6158,6 +6166,54 @@ TestSocketCmd(
/*
*----------------------------------------------------------------------
*
+ * TestServiceModeCmd --
+ *
+ * This procedure implements the "testservicemode" command which gets or
+ * sets the current Tcl ServiceMode. There are several tests which open
+ * a file and assign various handlers to it. For these tests to be
+ * deterministic it is important that file events not be processed until
+ * all of the handlers are in place.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May change the ServiceMode setting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestServiceModeCmd(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ int newmode, oldmode;
+ if (argc > 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ?newmode?\"", NULL);
+ return TCL_ERROR;
+ }
+ oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE);
+ if (argc == 2) {
+ if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (newmode == 0) {
+ Tcl_SetServiceMode(TCL_SERVICE_NONE);
+ } else {
+ Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestWrongNumArgsObjCmd --
*
* Test the Tcl_WrongNumArgs function.
@@ -6173,7 +6229,7 @@ TestSocketCmd(
static int
TestWrongNumArgsObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -6229,7 +6285,7 @@ TestWrongNumArgsObjCmd(
static int
TestGetIndexFromObjStructObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -6283,7 +6339,7 @@ TestGetIndexFromObjStructObjCmd(
static int
TestFilesystemObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6625,7 +6681,7 @@ TestReportNormalizePath(
static int
SimplePathInFilesystem(
Tcl_Obj *pathPtr,
- TCL_UNUSED(ClientData *))
+ TCL_UNUSED(void **))
{
const char *str = Tcl_GetString(pathPtr);
@@ -6654,7 +6710,7 @@ SimplePathInFilesystem(
static int
TestSimpleFilesystemObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6825,39 +6881,43 @@ TestUtfNextCmd(
char *bytes;
const char *result, *first;
char buffer[32];
- static const char tobetested[] = "\xFF\xFE\xF4\xF2\xF0\xEF\xE8\xE3\xE2\xE1\xE0\xC2\xC1\xC0\x82";
+ static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
const char *p = tobetested;
- if (objc != 3 || strcmp(Tcl_GetString(objv[1]), "-bytestring")) {
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
- return TCL_ERROR;
- }
- bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- } else {
- bytes = (char *) Tcl_GetBytesFromObj(interp, objv[2], &numBytes);
- if (bytes == NULL) {
- return TCL_ERROR;
- }
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
+ return TCL_ERROR;
}
+ bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- if (numBytes > (int)sizeof(buffer)-2) {
- Tcl_AppendResult(interp, "\"testutfnext\" can only handle 30 bytes", NULL);
+ if (numBytes > (int)sizeof(buffer) - 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"testutfnext\" can only handle %d bytes",
+ (int)sizeof(buffer) - 4));
return TCL_ERROR;
}
memcpy(buffer + 1, bytes, numBytes);
- buffer[0] = buffer[numBytes + 1] = '\x00';
+ buffer[0] = buffer[numBytes + 1] = buffer[numBytes + 2] = buffer[numBytes + 3] = '\xA0';
- first = result = TclUtfNext(buffer + 1);
+ first = result = Tcl_UtfNext(buffer + 1);
while ((buffer[0] = *p++) != '\0') {
/* Run Tcl_UtfNext with many more possible bytes at src[-1], all should give the same result */
- result = TclUtfNext(buffer + 1);
+ result = Tcl_UtfNext(buffer + 1);
if (first != result) {
Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", NULL);
return TCL_ERROR;
}
}
+ p = tobetested;
+ while ((buffer[numBytes + 1] = *p++) != '\0') {
+ /* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */
+ result = Tcl_UtfNext(buffer + 1);
+ if (first != result) {
+ first = buffer;
+ break;
+ }
+ }
Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1));
@@ -6879,17 +6939,13 @@ TestUtfPrevCmd(
int numBytes, offset;
char *bytes;
const char *result;
- Tcl_Obj *copy;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
return TCL_ERROR;
}
- bytes = (char *) Tcl_GetBytesFromObj(interp, objv[1], &numBytes);
- if (bytes == NULL) {
- return TCL_ERROR;
- }
+ bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
if (objc == 3) {
if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
@@ -6904,14 +6960,8 @@ TestUtfPrevCmd(
} else {
offset = numBytes;
}
- copy = Tcl_DuplicateObj(objv[1]);
- bytes = (char *) Tcl_SetByteArrayLength(copy, numBytes+1);
- bytes[numBytes] = '\0';
-
result = TclUtfPrev(bytes + offset, bytes);
Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes));
-
- Tcl_DecrRefCount(copy);
return TCL_OK;
}
@@ -6921,7 +6971,7 @@ TestUtfPrevCmd(
static int
TestNumUtfCharsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6950,7 +7000,7 @@ TestNumUtfCharsCmd(
static int
TestFindFirstCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6972,7 +7022,7 @@ TestFindFirstCmd(
static int
TestFindLastCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -7014,7 +7064,7 @@ TestFindLastCmd(
static int
TestcpuidCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
@@ -7050,7 +7100,7 @@ TestcpuidCmd(
static int
TestHashSystemHashCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -7126,7 +7176,7 @@ TestHashSystemHashCmd(
*/
static int
TestgetintCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int argc,
const char **argv)
@@ -7153,7 +7203,7 @@ TestgetintCmd(
*/
static int
TestlongsizeCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int argc,
TCL_UNUSED(const char **) /*argv*/)
@@ -7195,7 +7245,7 @@ NREUnwind_callback(
static int
TestNREUnwind(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
@@ -7213,7 +7263,7 @@ TestNREUnwind(
static int
TestNRELevels(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
@@ -7269,7 +7319,7 @@ TestNRELevels(
static int
TestconcatobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*argc*/,
TCL_UNUSED(const char **) /*argv*/)
@@ -7565,7 +7615,7 @@ TestconcatobjCmd(
static int
TestgetencpathObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
@@ -7598,7 +7648,7 @@ TestgetencpathObjCmd(
static int
TestsetencpathObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
@@ -7632,7 +7682,7 @@ TestsetencpathObjCmd(
static int
TestparseargsCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
@@ -7871,7 +7921,7 @@ InterpCompiledVarResolver(
static int
TestInterpResolverCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -7887,7 +7937,7 @@ TestInterpResolverCmd(
return TCL_ERROR;
}
if (objc == 3) {
- interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
+ interp = Tcl_GetChild(interp, Tcl_GetString(objv[2]));
if (interp == NULL) {
Tcl_AppendResult(interp, "provided interpreter not found", NULL);
return TCL_ERROR;
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index bfd0a45..bd5d92e 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -149,7 +149,7 @@ TclObjTest_Init(
static int
TestbignumobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
@@ -348,7 +348,7 @@ TestbignumobjCmd(
static int
TestbooleanobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -448,7 +448,7 @@ TestbooleanobjCmd(
static int
TestdoubleobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -566,7 +566,7 @@ TestdoubleobjCmd(
static int
TestindexobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -627,7 +627,7 @@ TestindexobjCmd(
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
- argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
+ argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
ckfree(argv);
if (result == TCL_OK) {
@@ -656,7 +656,7 @@ TestindexobjCmd(
static int
TestintobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -860,7 +860,7 @@ TestintobjCmd(
static int
TestlistobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument objects */
@@ -957,7 +957,7 @@ TestlistobjCmd(
static int
TestobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1169,7 +1169,7 @@ TestobjCmd(
static int
TeststringobjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 09dfbef..db6ec8a 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -228,7 +228,7 @@ ProcBodyTestInitInternal(
static int
ProcBodyTestProcObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
int objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
@@ -327,7 +327,7 @@ ProcBodyTestProcObjCmd(
static int
ProcBodyTestCheckObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
int objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
diff --git a/generic/tclThread.c b/generic/tclThread.c
index f22653a..76aaf4b 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -126,7 +126,7 @@ TclThreadDataKeyGet(
* Keep a list of (mutexes/condition variable/data key) used during
* finalization.
*
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -187,7 +187,7 @@ RememberSyncObject(
* ForgetSyncObject
*
* Remove a single object from the list.
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -219,7 +219,7 @@ ForgetSyncObject(
* TclRememberMutex
*
* Keep a list of mutexes used during finalization.
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -262,9 +262,9 @@ Tcl_MutexFinalize(
#if TCL_THREADS
TclpFinalizeMutex(mutexPtr);
#endif
- TclpMasterLock();
+ TclpGlobalLock();
ForgetSyncObject(mutexPtr, &mutexRecord);
- TclpMasterUnlock();
+ TclpGlobalUnlock();
}
/*
@@ -273,7 +273,7 @@ Tcl_MutexFinalize(
* TclRememberCondition
*
* Keep a list of condition variables used during finalization.
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -316,9 +316,9 @@ Tcl_ConditionFinalize(
#if TCL_THREADS
TclpFinalizeCondition(condPtr);
#endif
- TclpMasterLock();
+ TclpGlobalLock();
ForgetSyncObject(condPtr, &condRecord);
- TclpMasterUnlock();
+ TclpGlobalUnlock();
}
/*
@@ -382,7 +382,7 @@ TclFinalizeSynchronization(void)
Tcl_Mutex *mutexPtr;
Tcl_Condition *condPtr;
- TclpMasterLock();
+ TclpGlobalLock();
#endif
/*
@@ -404,7 +404,7 @@ TclFinalizeSynchronization(void)
#if TCL_THREADS
/*
- * Call thread storage master cleanup.
+ * Call thread storage global cleanup.
*/
TclFinalizeThreadStorage();
@@ -435,7 +435,7 @@ TclFinalizeSynchronization(void)
condRecord.max = 0;
condRecord.num = 0;
- TclpMasterUnlock();
+ TclpGlobalUnlock();
#endif /* TCL_THREADS */
}
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 99e6bac..74c23af 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -27,11 +27,11 @@
*/
/*
- * The master collection of information about TSDs. This is shared across the
+ * The global collection of information about TSDs. This is shared across the
* whole process, and includes the mutex used to protect it.
*/
-static struct TSDMaster {
+static struct {
void *key; /* Key into the system TSD structure. The
* collection of Tcl TSD values for a
* particular thread will hang off the
@@ -41,13 +41,13 @@ static struct TSDMaster {
* increasing value. */
Tcl_Mutex mutex; /* Protection for the rest of this structure,
* which holds per-process data. */
-} tsdMaster = { NULL, 0, NULL };
+} tsdGlobal = { NULL, 0, NULL };
/*
* The type of the data held per thread in a system TSD.
*/
-typedef struct TSDTable {
+typedef struct {
ClientData *tablePtr; /* The table of Tcl TSDs. */
sig_atomic_t allocated; /* The size of the table in the current
* thread. */
@@ -57,7 +57,7 @@ typedef struct TSDTable {
* The actual type of Tcl_ThreadDataKey.
*/
-typedef union TSDUnion {
+typedef union {
volatile sig_atomic_t offset;
/* The type is really an offset into the
* thread-local table of TSDs, which is this
@@ -189,7 +189,7 @@ void *
TclThreadStorageKeyGet(
Tcl_ThreadDataKey *dataKeyPtr)
{
- TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key);
ClientData resultPtr = NULL;
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
sig_atomic_t offset = keyPtr->offset;
@@ -223,12 +223,12 @@ TclThreadStorageKeySet(
Tcl_ThreadDataKey *dataKeyPtr,
void *value)
{
- TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key);
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
if (tsdTablePtr == NULL) {
tsdTablePtr = TSDTableCreate();
- TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
+ TclpThreadSetGlobalTSD(tsdGlobal.key, tsdTablePtr);
}
/*
@@ -240,15 +240,15 @@ TclThreadStorageKeySet(
*/
if (keyPtr->offset == 0) {
- Tcl_MutexLock(&tsdMaster.mutex);
+ Tcl_MutexLock(&tsdGlobal.mutex);
if (keyPtr->offset == 0) {
/*
* The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
*/
- keyPtr->offset = ++tsdMaster.counter;
+ keyPtr->offset = ++tsdGlobal.counter;
}
- Tcl_MutexUnlock(&tsdMaster.mutex);
+ Tcl_MutexUnlock(&tsdGlobal.mutex);
}
/*
@@ -288,11 +288,11 @@ TclThreadStorageKeySet(
void
TclFinalizeThreadDataThread(void)
{
- TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key);
if (tsdTablePtr != NULL) {
TSDTableDelete(tsdTablePtr);
- TclpThreadSetMasterTSD(tsdMaster.key, NULL);
+ TclpThreadSetGlobalTSD(tsdGlobal.key, NULL);
}
}
@@ -316,7 +316,7 @@ TclFinalizeThreadDataThread(void)
void
TclInitThreadStorage(void)
{
- tsdMaster.key = TclpThreadCreateKey();
+ tsdGlobal.key = TclpThreadCreateKey();
}
/*
@@ -339,8 +339,8 @@ TclInitThreadStorage(void)
void
TclFinalizeThreadStorage(void)
{
- TclpThreadDeleteKey(tsdMaster.key);
- tsdMaster.key = NULL;
+ TclpThreadDeleteKey(tsdGlobal.key);
+ tsdGlobal.key = NULL;
}
#else /* !TCL_THREADS */
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index b1b64f4..b98623c 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -205,7 +205,7 @@ TclThread_Init(
static int
ThreadObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -293,7 +293,7 @@ ThreadObjCmd(
script = Tcl_GetStringFromObj(objv[2], &len);
if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
- (0 == strncmp(script, "-joinable", (size_t) len))) {
+ (0 == strncmp(script, "-joinable", len))) {
joinable = 1;
script = "testthread wait"; /* Just enter event loop */
} else {
@@ -310,7 +310,7 @@ ThreadObjCmd(
script = Tcl_GetStringFromObj(objv[2], &len);
joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
- && (0 == strncmp(script, "-joinable", (size_t) len)));
+ && (0 == strncmp(script, "-joinable", len)));
script = Tcl_GetString(objv[3]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
@@ -1105,7 +1105,7 @@ ThreadFreeProc(
static int
ThreadDeleteEvent(
Tcl_Event *eventPtr, /* Really ThreadEvent */
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
if (eventPtr->proc == ThreadEventProc) {
ckfree(((ThreadEvent *) eventPtr)->script);
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index e9257a0..b421cde 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -2,13 +2,46 @@
#define BN_TCL_H_
#ifdef MP_NO_STDINT
-#ifdef HAVE_STDINT_H
-# include <stdint.h>
+# ifdef HAVE_STDINT_H
+# include <stdint.h>
#else
-# include "../compat/stdint.h"
+# include "../compat/stdint.h"
+# endif
#endif
+#if defined(TCL_NO_TOMMATH_H)
+ typedef size_t mp_digit;
+ typedef int mp_sign;
+# define MP_ZPOS 0 /* positive integer */
+# define MP_NEG 1 /* negative */
+ typedef int mp_ord;
+# define MP_LT -1 /* less than */
+# define MP_EQ 0 /* equal to */
+# define MP_GT 1 /* greater than */
+ typedef int mp_err;
+# define MP_OKAY 0 /* no error */
+# define MP_ERR -1 /* unknown error */
+# define MP_MEM -2 /* out of mem */
+# define MP_VAL -3 /* invalid input */
+# define MP_ITER -4 /* maximum iterations reached */
+# define MP_BUF -5 /* buffer overflow, supplied buffer too small */
+# define MP_WUR /* nothing */
+# define mp_iszero(a) ((a)->used == 0)
+# define mp_isneg(a) ((a)->sign != 0)
+
+ /* the infamous mp_int structure */
+# ifndef MP_INT_DECLARED
+# define MP_INT_DECLARED
+ typedef struct mp_int mp_int;
+# endif
+ struct mp_int {
+ int used, alloc;
+ mp_sign sign;
+ mp_digit *dp;
+};
+
+#elif !defined(BN_H_) /* If BN_H_ already defined, don't try to include tommath.h again. */
+# include "tommath.h"
#endif
-#include "tommath.h"
#include "tclTomMathDecls.h"
#endif
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 736a640..1427e8b 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -744,7 +744,7 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
#undef mp_iseven
#undef mp_isodd
#define mp_iseven(a) (!mp_isodd(a))
-#define mp_isodd(a) (((a)->used != 0 && (((a)->dp[0] & 1) != 0)) ? MP_YES : MP_NO)
+#define mp_isodd(a) (((a)->used != 0) && (((a)->dp[0] & 1) != 0))
#undef mp_sqr
#define mp_sqr(a,b) mp_mul(a,a,b)
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index e05fa69..300e0b9 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -183,7 +183,7 @@ typedef struct {
int
Tcl_TraceObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1848,7 +1848,7 @@ TraceExecutionProc(
* Append result code.
*/
- resultCode = Tcl_NewIntObj(code);
+ TclNewIntObj(resultCode, code);
resultCodeStr = Tcl_GetString(resultCode);
Tcl_DStringAppendElement(&cmd, resultCodeStr);
Tcl_DecrRefCount(resultCode);
@@ -1976,7 +1976,7 @@ TraceVarProc(
int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
- * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
+ * We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete]
* which might try to free tvarPtr. We want to use tvarPtr until the end
* of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
* it is not freed while we still need it.
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 19e1365..11bde5c 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -55,7 +55,7 @@
#define UNICODE_SELF 0x80
/*
- * The following structures are used when mapping between Unicode (UCS-2) and
+ * The following structures are used when mapping between Unicode and
* UTF-8.
*/
@@ -69,7 +69,13 @@ static const unsigned char totalBytes[256] = {
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
/* End of "continuation byte section" */
2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
- 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1
+ 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
+#if TCL_UTF_MAX > 3
+ 4,4,4,4,4,
+#else
+ 1,1,1,1,1,
+#endif
+ 1,1,1,1,1,1,1,1,1,1,1
};
static const unsigned char complete[256] = {
@@ -86,7 +92,7 @@ static const unsigned char complete[256] = {
#if TCL_UTF_MAX > 3
4,4,4,4,4,
#else
- 1,1,1,1,1,
+ 3,3,3,3,3,
#endif
1,1,1,1,1,1,1,1,1,1,1
};
@@ -95,12 +101,7 @@ static const unsigned char complete[256] = {
* Functions used only in this module.
*/
-static int Invalid(unsigned char *src);
-
-#define UCS4ToUpper Tcl_UniCharToUpper
-#define UCS4ToLower Tcl_UniCharToLower
-#define UCS4ToTitle Tcl_UniCharToTitle
-
+static int Invalid(const char *src);
/*
*---------------------------------------------------------------------------
@@ -139,15 +140,23 @@ TclUtfCount(
*
* Invalid --
*
- * Utility routine to report whether /src/ points to the start of an
- * invald byte sequence that should be rejected. This might be because
- * it is an overlong encoding, or because it encodes something out of
- * the proper range. Caller guarantees that src[0] and src[1] are
- * readable, and
+ * Given a pointer to a two-byte prefix of a well-formed UTF-8 byte
+ * sequence (a lead byte followed by a trail byte) this routine
+ * examines those two bytes to determine whether the sequence is
+ * invalid in UTF-8. This might be because it is an overlong
+ * encoding, or because it encodes something out of the proper range.
+ *
+ * Given a pointer to the bytes \xF8 or \xFC , this routine will
+ * try to read beyond the end of the "bounds" table. Callers must
+ * prevent this.
*
- * (src[0] >= 0xC0) && (src[0] != 0xC1)
- * (src[1] >= 0x80) && (src[1] < 0xC0)
- * (src[0] < ((TCL_UTF_MAX > 3) ? 0xF5 : 0xF0))
+ * Given a pointer to something else (an ASCII byte, a trail byte,
+ * or another byte that can never begin a valid byte sequence such
+ * as \xF5) this routine returns false. That makes the routine poorly
+ * named, as it does not detect and report all invalid sequences.
+ *
+ * Callers have to take care that this routine does something useful
+ * for their needs.
*
* Results:
* A boolean.
@@ -166,19 +175,18 @@ static const unsigned char bounds[28] = {
static int
Invalid(
- unsigned char *src) /* Points to lead byte of a UTF-8 byte sequence */
+ const char *src) /* Points to lead byte of a UTF-8 byte sequence */
{
- unsigned char byte = *src;
+ unsigned char byte = UCHAR(*src);
int index;
- if (byte % 0x04) {
+ if ((byte & 0xC3) == 0xC0) {
/* Only lead bytes 0xC0, 0xE0, 0xF0, 0xF4 need examination */
- return 0;
- }
- index = (byte - 0xC0) >> 1;
- if (src[1] < bounds[index] || src[1] > bounds[index+1]) {
- /* Out of bounds - report invalid. */
- return 1;
+ index = (byte - 0xC0) >> 1;
+ if (UCHAR(src[1]) < bounds[index] || UCHAR(src[1]) > bounds[index+1]) {
+ /* Out of bounds - report invalid. */
+ return 1;
+ }
}
return 0;
}
@@ -443,7 +451,7 @@ static const unsigned short cp1252[32] = {
int
Tcl_UtfToUniChar(
const char *src, /* The UTF-8 string. */
- int *chPtr)/* Filled with the unsigned int represented by
+ int *chPtr)/* Filled with the Unicode character represented by
* the UTF-8 string. */
{
int byte;
@@ -502,7 +510,7 @@ Tcl_UtfToUniChar(
* represents itself.
*/
}
- else if (byte < 0xF8) {
+ else if (byte < 0xF5) {
if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
/*
* Four-byte-character lead byte followed by three trail bytes.
@@ -527,8 +535,8 @@ Tcl_UtfToUniChar(
int
Tcl_UtfToChar16(
const char *src, /* The UTF-8 string. */
- unsigned short *chPtr)/* Filled with the unsigned short represented by
- * the UTF-8 string. */
+ unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
+ * the UTF-8 string. This could be a surrogate too. */
{
unsigned short byte;
@@ -536,7 +544,7 @@ Tcl_UtfToChar16(
* Unroll 1 to 4 byte UTF-8 sequences.
*/
- byte = *((unsigned char *) src);
+ byte = UCHAR(*src);
if (byte < 0xC0) {
/*
* Handles properly formed UTF-8 characters between 0x01 and 0x7F.
@@ -598,20 +606,20 @@ Tcl_UtfToChar16(
* represents itself.
*/
}
- else if (byte < 0xF8) {
- if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
+ else if (byte < 0xF5) {
+ if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
/*
- * Four-byte-character lead byte followed by three trail bytes.
+ * Four-byte-character lead byte followed by at least two trail bytes.
+ * We don't test the validity of 3th trail byte, see [ed29806ba]
*/
- unsigned short high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2)
+ Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2)
| ((src[2] & 0x3F) >> 4)) - 0x40;
- if (high >= 0x400) {
- /* out of range, < 0x10000 or > 0x10FFFF */
- } else {
+ if (high < 0x400) {
/* produce high surrogate, advance source pointer */
*chPtr = 0xD800 + high;
return 1;
}
+ /* out of range, < 0x10000 or > 0x10FFFF */
}
/*
@@ -653,8 +661,12 @@ Tcl_UtfToUniCharDString(
* DString. */
{
int ch = 0, *w, *wString;
- const char *p, *end;
+ const char *p;
int oldLength;
+ /* Pointer to the end of string. Never read endPtr[0] */
+ const char *endPtr = src + length;
+ /* Pointer to last byte where optimization still can be used */
+ const char *optPtr = endPtr - TCL_UTF_MAX;
if (src == NULL) {
return NULL;
@@ -676,20 +688,19 @@ Tcl_UtfToUniCharDString(
w = wString;
p = src;
- end = src + length - 4;
- while (p < end) {
- p += Tcl_UtfToUniChar(p, &ch);
+ endPtr = src + length;
+ optPtr = endPtr - 4;
+ while (p <= optPtr) {
+ p += TclUtfToUCS4(p, &ch);
*w++ = ch;
}
- end += 4;
- while (p < end) {
- if (Tcl_UtfCharComplete(p, end-p)) {
- p += Tcl_UtfToUniChar(p, &ch);
- } else {
- ch = UCHAR(*p++);
- }
+ while ((p < endPtr) && TclUCS4Complete(p, endPtr-p)) {
+ p += TclUtfToUCS4(p, &ch);
*w++ = ch;
}
+ while (p < endPtr) {
+ *w++ = UCHAR(*p++);
+ }
*w = '\0';
Tcl_DStringSetLength(dsPtr,
oldLength + ((char *) w - (char *) wString));
@@ -706,10 +717,13 @@ Tcl_UtfToChar16DString(
* appended to this previously initialized
* DString. */
{
- unsigned short ch = 0;
- unsigned short *w, *wString;
- const char *p, *end;
+ unsigned short ch = 0, *w, *wString;
+ const char *p;
int oldLength;
+ /* Pointer to the end of string. Never read endPtr[0] */
+ const char *endPtr = src + length;
+ /* Pointer to last byte where optimization still can be used */
+ const char *optPtr = endPtr - TCL_UTF_MAX;
if (src == NULL) {
return NULL;
@@ -731,19 +745,19 @@ Tcl_UtfToChar16DString(
w = wString;
p = src;
- end = src + length - 4;
- while (p < end) {
+ endPtr = src + length;
+ optPtr = endPtr - 3;
+ while (p <= optPtr) {
p += Tcl_UtfToChar16(p, &ch);
*w++ = ch;
}
- end += 4;
- while (p < end) {
- if (Tcl_UtfCharComplete(p, end-p)) {
+ while (p < endPtr) {
+ if (TclChar16Complete(p, endPtr-p)) {
p += Tcl_UtfToChar16(p, &ch);
+ *w++ = ch;
} else {
- ch = UCHAR(*p++);
+ *w++ = UCHAR(*p++);
}
- *w++ = ch;
}
*w = '\0';
Tcl_DStringSetLength(dsPtr,
@@ -751,6 +765,7 @@ Tcl_UtfToChar16DString(
return wString;
}
+
/*
*---------------------------------------------------------------------------
*
@@ -776,7 +791,7 @@ Tcl_UtfCharComplete(
* a complete UTF-8 character. */
int length) /* Length of above string in bytes. */
{
- return length >= complete[(unsigned char)*src];
+ return length >= complete[UCHAR(*src)];
}
/*
@@ -800,40 +815,51 @@ Tcl_UtfCharComplete(
int
Tcl_NumUtfChars(
const char *src, /* The UTF-8 string to measure. */
- int length) /* The length of the string in bytes, or -1
- * for strlen(string). */
+ int length) /* The length of the string in bytes, or -1
+ * for strlen(string). */
{
Tcl_UniChar ch = 0;
int i = 0;
- /*
- * The separate implementations are faster.
- *
- * Since this is a time-sensitive function, we also do the check for the
- * single-byte char case specially.
- */
-
if (length < 0) {
- while (*src != '\0') {
+ /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
+ while ((*src != '\0') && (i < INT_MAX)) {
src += TclUtfToUniChar(src, &ch);
i++;
}
- if (i < 0) i = INT_MAX; /* Bug [2738427] */
} else {
- const char *endPtr = src + length - 4;
+ /* Will return value between 0 and length. No overflow checks. */
- while (src < endPtr) {
+ /* Pointer to the end of string. Never read endPtr[0] */
+ const char *endPtr = src + length;
+ /* Pointer to last byte where optimization still can be used */
+ const char *optPtr = endPtr - TCL_UTF_MAX;
+
+ /*
+ * Optimize away the call in this loop. Justified because...
+ * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr)
+ * By initialization above (endPtr - optPtr) = TCL_UTF_MAX
+ * So (endPtr - src) >= TCL_UTF_MAX, and passing that to
+ * Tcl_UtfCharComplete we know will cause return of 1.
+ */
+ while (src <= optPtr
+ /* && Tcl_UtfCharComplete(src, endPtr - src) */ ) {
src += TclUtfToUniChar(src, &ch);
i++;
}
- endPtr += 4;
- while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
- src += TclUtfToUniChar(src, &ch);
+ /* Loop over the remaining string where call must happen */
+ while (src < endPtr) {
+ if (Tcl_UtfCharComplete(src, endPtr - src)) {
+ src += TclUtfToUniChar(src, &ch);
+ } else {
+ /*
+ * src points to incomplete UTF-8 sequence
+ * Treat first byte as character and count it
+ */
+ src++;
+ }
i++;
}
- if (src < endPtr) {
- i += endPtr - src;
- }
}
return i;
}
@@ -843,7 +869,7 @@ Tcl_NumUtfChars(
*
* Tcl_UtfFindFirst --
*
- * Returns a pointer to the first occurance of the given Unicode character
+ * Returns a pointer to the first occurrence of the given Unicode character
* in the NULL-terminated UTF-8 string. The NULL terminator is considered
* part of the UTF-8 string. Equivalent to Plan 9 utfrune().
*
@@ -863,9 +889,9 @@ Tcl_UtfFindFirst(
int ch) /* The Unicode character to search for. */
{
while (1) {
- int ucs4, len = TclUtfToUCS4(src, &ucs4);
+ int find, len = TclUtfToUCS4(src, &find);
- if (ucs4 == ch) {
+ if (find == ch) {
return src;
}
if (*src == '\0') {
@@ -880,7 +906,7 @@ Tcl_UtfFindFirst(
*
* Tcl_UtfFindLast --
*
- * Returns a pointer to the last occurance of the given Unicode character
+ * Returns a pointer to the last occurrence of the given Unicode character
* in the NULL-terminated UTF-8 string. The NULL terminator is considered
* part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
*
@@ -902,9 +928,9 @@ Tcl_UtfFindLast(
const char *last = NULL;
while (1) {
- int ucs4, len = TclUtfToUCS4(src, &ucs4);
+ int find, len = TclUtfToUCS4(src, &find);
- if (ucs4 == ch) {
+ if (find == ch) {
last = src;
}
if (*src == '\0') {
@@ -940,8 +966,8 @@ const char *
Tcl_UtfNext(
const char *src) /* The current location in the string. */
{
- int left = totalBytes[UCHAR(*src)];
- const char *next = src + 1;
+ int left;
+ const char *next;
if (((*src) & 0xC0) == 0x80) {
if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) {
@@ -950,6 +976,8 @@ Tcl_UtfNext(
return src;
}
+ left = totalBytes[UCHAR(*src)];
+ next = src + 1;
while (--left) {
if ((*next & 0xC0) != 0x80) {
/*
@@ -961,7 +989,14 @@ Tcl_UtfNext(
}
next++;
}
- if ((next == src + 1) || Invalid((unsigned char *)src)) {
+ /*
+ * Call Invalid() here only if required conditions are met:
+ * src[0] is known a lead byte.
+ * src[1] is known a trail byte.
+ * Especially important to prevent calls when src[0] == '\xF8' or '\xFC'
+ * See tests utf-6.37 through utf-6.43 through valgrind or similar tool.
+ */
+ if ((next == src + 1) || Invalid(src)) {
return src + 1;
}
return next;
@@ -998,7 +1033,7 @@ Tcl_UtfPrev(
/* If we cannot find a lead byte that might
* start a prefix of a valid UTF byte sequence,
* we will fallback to a one-byte back step */
- unsigned char *look = (unsigned char *)fallback;
+ const char *look = fallback;
/* Start search at the fallback position */
/* Quick boundary case exit. */
@@ -1007,7 +1042,7 @@ Tcl_UtfPrev(
}
do {
- unsigned char byte = look[0];
+ unsigned char byte = UCHAR(look[0]);
if (byte < 0x80) {
/*
@@ -1029,7 +1064,7 @@ Tcl_UtfPrev(
* it (the fallback) is correct.
*/
- || (trailBytesSeen >= totalBytes[byte])) {
+ || (trailBytesSeen >= complete[byte])) {
/*
* That is, (1 + trailBytesSeen > needed).
* We've examined more bytes than needed to complete
@@ -1043,7 +1078,7 @@ Tcl_UtfPrev(
/*
* trailBytesSeen > 0, so we can examine look[1] safely.
- * Use that capability to screen out overlong sequences.
+ * Use that capability to screen out invalid sequences.
*/
if (Invalid(look)) {
@@ -1070,7 +1105,7 @@ Tcl_UtfPrev(
/* Continue the search backwards... */
look--;
- } while (trailBytesSeen < 4);
+ } while (trailBytesSeen < TCL_UTF_MAX);
/*
* We've seen TCL_UTF_MAX trail bytes, so we know there will not be a
@@ -1078,7 +1113,11 @@ Tcl_UtfPrev(
* accepting the fallback (for TCL_UTF_MAX > 3) or just go back as
* far as we can.
*/
+#if TCL_UTF_MAX > 3
return fallback;
+#else
+ return src - TCL_UTF_MAX;
+#endif
}
/*
@@ -1103,10 +1142,24 @@ Tcl_UniCharAtIndex(
const char *src, /* The UTF-8 string to dereference. */
int index) /* The position of the desired character. */
{
- int ch = 0;
+ Tcl_UniChar ch = 0;
+ int i = 0;
- TclUtfToUCS4(Tcl_UtfAtIndex(src, index), &ch);
- return ch;
+ if (index < 0) {
+ return -1;
+ }
+ while (index-- > 0) {
+ i = TclUtfToUniChar(src, &ch);
+ src += i;
+ }
+#if TCL_UTF_MAX <= 3
+ if ((ch >= 0xD800) && (i < 3)) {
+ /* Index points at character following high Surrogate */
+ return -1;
+ }
+#endif
+ TclUtfToUCS4(src, &i);
+ return i;
}
/*
@@ -1235,7 +1288,7 @@ Tcl_UtfToUpper(
src = dst = str;
while (*src) {
len = TclUtfToUCS4(src, &ch);
- upChar = UCS4ToUpper(ch);
+ upChar = Tcl_UniCharToUpper(ch);
/*
* To keep badly formed Utf strings from getting inflated by the
@@ -1243,7 +1296,7 @@ Tcl_UtfToUpper(
* char to dst if its size is <= the original char.
*/
- if ((len < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) {
+ if ((len < TclUtfCount(upChar)) || ((upChar & ~0x7FF) == 0xD800)) {
memmove(dst, src, len);
dst += len;
} else {
@@ -1288,7 +1341,7 @@ Tcl_UtfToLower(
src = dst = str;
while (*src) {
len = TclUtfToUCS4(src, &ch);
- lowChar = UCS4ToLower(ch);
+ lowChar = Tcl_UniCharToLower(ch);
/*
* To keep badly formed Utf strings from getting inflated by the
@@ -1296,7 +1349,7 @@ Tcl_UtfToLower(
* char to dst if its size is <= the original char.
*/
- if ((len < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
+ if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) {
memmove(dst, src, len);
dst += len;
} else {
@@ -1344,9 +1397,9 @@ Tcl_UtfToTitle(
if (*src) {
len = TclUtfToUCS4(src, &ch);
- titleChar = UCS4ToTitle(ch);
+ titleChar = Tcl_UniCharToTitle(ch);
- if ((len < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) {
+ if ((len < TclUtfCount(titleChar)) || ((titleChar & ~0x7FF) == 0xD800)) {
memmove(dst, src, len);
dst += len;
} else {
@@ -1359,10 +1412,10 @@ Tcl_UtfToTitle(
lowChar = ch;
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
- lowChar = UCS4ToLower(lowChar);
+ lowChar = Tcl_UniCharToLower(lowChar);
}
- if ((len < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
+ if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) {
memmove(dst, src, len);
dst += len;
} else {
@@ -1656,6 +1709,7 @@ Tcl_UniCharToUpper(
ch -= GetDelta(info);
}
}
+ /* Clear away extension bits, if any */
return ch & 0x1FFFFF;
}
@@ -1687,6 +1741,7 @@ Tcl_UniCharToLower(
ch += GetDelta(info);
}
}
+ /* Clear away extension bits, if any */
return ch & 0x1FFFFF;
}
@@ -1726,6 +1781,7 @@ Tcl_UniCharToTitle(
ch -= GetDelta(info);
}
}
+ /* Clear away extension bits, if any */
return ch & 0x1FFFFF;
}
@@ -1913,6 +1969,7 @@ Tcl_UniCharIsControl(
int ch) /* Unicode character to test. */
{
if (UNICODE_OUT_OF_RANGE(ch)) {
+ /* Clear away extension bits, if any */
ch &= 0x1FFFFF;
if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007F))) {
return 1;
@@ -2564,6 +2621,20 @@ TclUtfToUCS4(
/* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
return Tcl_UtfToUniChar(src, ucs4Ptr);
}
+
+int
+TclUniCharToUCS4(
+ const Tcl_UniChar *src, /* The Tcl_UniChar string. */
+ int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
+ * by the Tcl_UniChar string. */
+{
+ if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
+ *ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[01] & 0x3FF)) + 0x10000;
+ return 2;
+ }
+ *ucs4Ptr = src[0];
+ return 1;
+}
#endif
/*
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index dd527dc..8db6606 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -108,7 +108,7 @@ static Tcl_ThreadDataKey precisionKey;
static void ClearHash(Tcl_HashTable *tablePtr);
static void FreeProcessGlobalValue(ClientData clientData);
static void FreeThreadHash(ClientData clientData);
-static int GetEndOffsetFromObj(Tcl_Obj *objPtr,
+static int GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
size_t endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -1857,8 +1857,9 @@ TclTrim(
/* If we did not trim the whole string, it starts with a character
* that we will not trim. Skip over it. */
if (numBytes > 0) {
+ int ch;
const char *first = bytes + trimLeft;
- bytes = TclUtfNext(first);
+ bytes += TclUtfToUCS4(first, &ch);
numBytes -= (bytes - first);
if (numBytes > 0) {
@@ -2161,7 +2162,7 @@ Tcl_StringCaseMatch(
int nocase) /* 0 for case sensitive, 1 for insensitive */
{
int p, charLen;
- Tcl_UniChar ch1 = 0, ch2 = 0;
+ int ch1 = 0, ch2 = 0;
while (1) {
p = *pattern;
@@ -2202,10 +2203,10 @@ Tcl_StringCaseMatch(
*/
if (UCHAR(*pattern) < 0x80) {
- ch2 = (Tcl_UniChar)
+ ch2 = (int)
(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
} else {
- Tcl_UtfToUniChar(pattern, &ch2);
+ TclUtfToUCS4(pattern, &ch2);
if (nocase) {
ch2 = Tcl_UniCharToLower(ch2);
}
@@ -2221,7 +2222,7 @@ Tcl_StringCaseMatch(
if ((p != '[') && (p != '?') && (p != '\\')) {
if (nocase) {
while (*str) {
- charLen = TclUtfToUniChar(str, &ch1);
+ charLen = TclUtfToUCS4(str, &ch1);
if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
break;
}
@@ -2235,7 +2236,7 @@ Tcl_StringCaseMatch(
*/
while (*str) {
- charLen = TclUtfToUniChar(str, &ch1);
+ charLen = TclUtfToUCS4(str, &ch1);
if (ch2 == ch1) {
break;
}
@@ -2249,7 +2250,7 @@ Tcl_StringCaseMatch(
if (*str == '\0') {
return 0;
}
- str += TclUtfToUniChar(str, &ch1);
+ str += TclUtfToUCS4(str, &ch1);
}
}
@@ -2260,7 +2261,7 @@ Tcl_StringCaseMatch(
if (p == '?') {
pattern++;
- str += TclUtfToUniChar(str, &ch1);
+ str += TclUtfToUCS4(str, &ch1);
continue;
}
@@ -2271,15 +2272,15 @@ Tcl_StringCaseMatch(
*/
if (p == '[') {
- Tcl_UniChar startChar = 0, endChar = 0;
+ int startChar = 0, endChar = 0;
pattern++;
if (UCHAR(*str) < 0x80) {
- ch1 = (Tcl_UniChar)
+ ch1 = (int)
(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
str++;
} else {
- str += Tcl_UtfToUniChar(str, &ch1);
+ str += TclUtfToUCS4(str, &ch1);
if (nocase) {
ch1 = Tcl_UniCharToLower(ch1);
}
@@ -2289,11 +2290,11 @@ Tcl_StringCaseMatch(
return 0;
}
if (UCHAR(*pattern) < 0x80) {
- startChar = (Tcl_UniChar) (nocase
+ startChar = (int) (nocase
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
- pattern += Tcl_UtfToUniChar(pattern, &startChar);
+ pattern += TclUtfToUCS4(pattern, &startChar);
if (nocase) {
startChar = Tcl_UniCharToLower(startChar);
}
@@ -2304,11 +2305,11 @@ Tcl_StringCaseMatch(
return 0;
}
if (UCHAR(*pattern) < 0x80) {
- endChar = (Tcl_UniChar) (nocase
+ endChar = (int) (nocase
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
- pattern += Tcl_UtfToUniChar(pattern, &endChar);
+ pattern += TclUtfToUCS4(pattern, &endChar);
if (nocase) {
endChar = Tcl_UniCharToLower(endChar);
}
@@ -2356,8 +2357,8 @@ Tcl_StringCaseMatch(
* each string match.
*/
- str += TclUtfToUniChar(str, &ch1);
- pattern += TclUtfToUniChar(pattern, &ch2);
+ str += TclUtfToUCS4(str, &ch1);
+ pattern += TclUtfToUCS4(pattern, &ch2);
if (nocase) {
if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
return 0;
@@ -2987,7 +2988,7 @@ Tcl_DStringGetResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
-#ifdef TCL_NO_DEPRECATED
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
Tcl_Obj *obj = Tcl_GetObjResult(interp);
const char *bytes = TclGetString(obj);
@@ -3631,9 +3632,8 @@ GetWideForIndex(
Tcl_WideInt *widePtr) /* Location filled in with a wide integer
* representing an index. */
{
+ int numType;
ClientData cd;
- const char *opPtr;
- int numType, length, t1 = 0, t2 = 0;
int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
if (code == TCL_OK) {
@@ -3642,152 +3642,16 @@ GetWideForIndex(
*widePtr = *(Tcl_WideInt *)cd;
return TCL_OK;
}
- if (numType != TCL_NUMBER_BIG) {
- /* Must be a double -> not a valid index */
- goto parseError;
- }
-
- /* objPtr holds an integer outside the signed wide range */
- /* Truncate to the signed wide range. */
- *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
- return TCL_OK;
- }
-
- /* objPtr does not hold a number, check the end+/- format... */
- if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
- return TCL_OK;
- }
-
- /* If we reach here, the string rep of objPtr exists. */
-
- /*
- * The valid index syntax does not include any value that is
- * a list of more than one element. This is necessary so that
- * lists of index values can be reliably distinguished from any
- * single index value.
- */
-
- /*
- * Quick scan to see if multi-value list is even possible.
- * This relies on TclGetString() returning a NUL-terminated string.
- */
- if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)
-
- /* If it's possible, do the full list parse. */
- && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
- && (length > 1)) {
- goto parseError;
- }
-
- /* Passed the list screen, so parse for index arithmetic expression */
- if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
- TCL_PARSE_INTEGER_ONLY)) {
- Tcl_WideInt w1=0, w2=0;
-
- /* value starts with valid integer... */
-
- if ((*opPtr == '-') || (*opPtr == '+')) {
- /* ... value continues with [-+] ... */
-
- /* Save first integer as wide if possible */
- TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
- if (t1 == TCL_NUMBER_INT) {
- w1 = (*(Tcl_WideInt *)cd);
- }
-
- if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
- -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
- /* ... value concludes with second valid integer */
-
- /* Save second integer as wide if possible */
- TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
- if (t2 == TCL_NUMBER_INT) {
- w2 = (*(Tcl_WideInt *)cd);
- }
- }
- }
- /* Clear invalid intreps left by TclParseNumber */
- TclFreeIntRep(objPtr);
-
- if (t1 && t2) {
- /* We have both integer values */
- if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
- /* Both are wide, do wide-integer math */
- if (*opPtr == '-') {
- if ((w2 == WIDE_MIN) && (interp != NULL)) {
- goto extreme;
- }
- w2 = -w2;
- }
-
- if ((w1 ^ w2) < 0) {
- /* Different signs, sum cannot overflow */
- *widePtr = w1 + w2;
- } else if (w1 >= 0) {
- if (w1 < WIDE_MAX - w2) {
- *widePtr = w1 + w2;
- } else {
- *widePtr = WIDE_MAX;
- }
- } else {
- if (w1 > WIDE_MIN - w2) {
- *widePtr = w1 + w2;
- } else {
- *widePtr = WIDE_MIN;
- }
- }
- } else if (interp == NULL) {
- /*
- * We use an interp to do bignum index calculations.
- * If we don't get one, call all indices with bignums errors,
- * and rely on callers to handle it.
- */
- return TCL_ERROR;
- } else {
- /*
- * At least one is big, do bignum math. Little reason to
- * value performance here. Re-use code. Parse has verified
- * objPtr is an expression. Compute it.
- */
-
- Tcl_Obj *sum;
-
- extreme:
- Tcl_ExprObj(interp, objPtr, &sum);
- TclGetNumberFromObj(NULL, sum, &cd, &numType);
-
- if (numType == TCL_NUMBER_INT) {
- /* sum holds an integer in the signed wide range */
- *widePtr = *(Tcl_WideInt *)cd;
- } else {
- /* sum holds an integer outside the signed wide range */
- /* Truncate to the signed wide range. */
- if (mp_isneg((mp_int *)cd)) {
- *widePtr = WIDE_MIN;
- } else {
- *widePtr = WIDE_MAX;
- }
- }
- Tcl_DecrRefCount(sum);
- }
+ if (numType == TCL_NUMBER_BIG) {
+ /* objPtr holds an integer outside the signed wide range */
+ /* Truncate to the signed wide range. */
+ *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
return TCL_OK;
}
}
- /* Report a parse error. */
- parseError:
- if (interp != NULL) {
- char * bytes = TclGetString(objPtr);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad index \"%s\": must be integer?[+-]integer? or"
- " end?[+-]integer?", bytes));
- if (!strncmp(bytes, "end-", 4)) {
- bytes += 4;
- }
- TclCheckBadOctal(interp, bytes);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
- }
- return TCL_ERROR;
+ /* objPtr does not hold a number, check the end+/- format... */
+ return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
}
/*
@@ -3824,19 +3688,23 @@ Tcl_GetIntForIndex(
int endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
int *indexPtr) /* Location filled in with an integer
- * representing an index. */
+ * representing an index. May be NULL.*/
{
Tcl_WideInt wide;
- if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
+ if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) {
return TCL_ERROR;
}
- if (wide < 0) {
- *indexPtr = -1;
- } else if (wide > INT_MAX) {
- *indexPtr = INT_MAX;
- } else {
- *indexPtr = (int) wide;
+ if (indexPtr != NULL) {
+ if ((wide < 0) && (endValue > TCL_INDEX_END)) {
+ *indexPtr = -1;
+ } else if (wide > INT_MAX) {
+ *indexPtr = INT_MAX;
+ } else if (wide < INT_MIN) {
+ *indexPtr = INT_MIN;
+ } else {
+ *indexPtr = (int) wide;
+ }
}
return TCL_OK;
}
@@ -3845,8 +3713,19 @@ Tcl_GetIntForIndex(
*
* GetEndOffsetFromObj --
*
- * Look for a string of the form "end[+-]offset" and convert it to an
- * internal representation holding the offset.
+ * Look for a string of the form "end[+-]offset" or "offset[+-]offset" and
+ * convert it to an internal representation.
+ *
+ * The internal representation (wideValue) uses the following encoding:
+ *
+ * WIDE_MIN: Index value TCL_INDEX_NONE (or -1)
+ * WIDE_MIN+1: Index value n, for any n < -1 (usually same effect as -1)
+ * -$n: Index "end-[expr {$n-1}]"
+ * -2: Index "end-1"
+ * -1: Index "end"
+ * 0: Index "0"
+ * WIDE_MAX-1: Index "end+n", for any n > 1
+ * WIDE_MAX: Index "end+1"
*
* Results:
* Tcl return code.
@@ -3859,6 +3738,7 @@ Tcl_GetIntForIndex(
static int
GetEndOffsetFromObj(
+ Tcl_Interp *interp,
Tcl_Obj *objPtr, /* Pointer to the object to parse */
size_t endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
@@ -3866,42 +3746,164 @@ GetEndOffsetFromObj(
* representing an index. */
{
Tcl_ObjIntRep *irPtr;
- Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */
+ Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */
+ ClientData cd;
while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) {
Tcl_ObjIntRep ir;
int length;
const char *bytes = TclGetStringFromObj(objPtr, &length);
- if ((length < 3) || (length == 4)) {
- /* Too short to be "end" or to be "end-$integer" */
- return TCL_ERROR;
- }
- if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) {
- /* Value doesn't start with "end" */
- return TCL_ERROR;
+ if (*bytes != 'e') {
+ int numType;
+ const char *opPtr;
+ int length, t1 = 0, t2 = 0;
+
+ /* Value doesn't start with "e" */
+
+ /* If we reach here, the string rep of objPtr exists. */
+
+ /*
+ * The valid index syntax does not include any value that is
+ * a list of more than one element. This is necessary so that
+ * lists of index values can be reliably distinguished from any
+ * single index value.
+ */
+
+ /*
+ * Quick scan to see if multi-value list is even possible.
+ * This relies on TclGetString() returning a NUL-terminated string.
+ */
+ if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)
+
+ /* If it's possible, do the full list parse. */
+ && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
+ && (length > 1)) {
+ goto parseError;
+ }
+
+ /* Passed the list screen, so parse for index arithmetic expression */
+ if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
+ TCL_PARSE_INTEGER_ONLY)) {
+ Tcl_WideInt w1=0, w2=0;
+
+ /* value starts with valid integer... */
+
+ if ((*opPtr == '-') || (*opPtr == '+')) {
+ /* ... value continues with [-+] ... */
+
+ /* Save first integer as wide if possible */
+ TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
+ if (t1 == TCL_NUMBER_INT) {
+ w1 = (*(Tcl_WideInt *)cd);
+ }
+
+ if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
+ -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
+ /* ... value concludes with second valid integer */
+
+ /* Save second integer as wide if possible */
+ TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
+ if (t2 == TCL_NUMBER_INT) {
+ w2 = (*(Tcl_WideInt *)cd);
+ }
+ }
+ }
+ /* Clear invalid intreps left by TclParseNumber */
+ TclFreeIntRep(objPtr);
+
+ if (t1 && t2) {
+ /* We have both integer values */
+ if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
+ /* Both are wide, do wide-integer math */
+ if (*opPtr == '-') {
+ if (w2 == WIDE_MIN) {
+ goto extreme;
+ }
+ w2 = -w2;
+ }
+
+ if ((w1 ^ w2) < 0) {
+ /* Different signs, sum cannot overflow */
+ offset = w1 + w2;
+ } else if (w1 >= 0) {
+ if (w1 < WIDE_MAX - w2) {
+ offset = w1 + w2;
+ } else {
+ offset = WIDE_MAX;
+ }
+ } else {
+ if (w1 > WIDE_MIN - w2) {
+ offset = w1 + w2;
+ } else {
+ offset = WIDE_MIN;
+ }
+ }
+ } else {
+ /*
+ * At least one is big, do bignum math. Little reason to
+ * value performance here. Re-use code. Parse has verified
+ * objPtr is an expression. Compute it.
+ */
+
+ Tcl_Obj *sum;
+
+ extreme:
+ if (interp) {
+ Tcl_ExprObj(interp, objPtr, &sum);
+ } else {
+ Tcl_Interp *compute = Tcl_CreateInterp();
+ Tcl_ExprObj(compute, objPtr, &sum);
+ Tcl_DeleteInterp(compute);
+ }
+ TclGetNumberFromObj(NULL, sum, &cd, &numType);
+
+ if (numType == TCL_NUMBER_INT) {
+ /* sum holds an integer in the signed wide range */
+ offset = *(Tcl_WideInt *)cd;
+ } else {
+ /* sum holds an integer outside the signed wide range */
+ /* Truncate to the signed wide range. */
+ if (mp_isneg((mp_int *)cd)) {
+ offset = WIDE_MIN;
+ } else {
+ offset = WIDE_MAX;
+ }
+ }
+ Tcl_DecrRefCount(sum);
+ }
+ if (offset < 0) {
+ offset = (offset == -1) ? WIDE_MIN : WIDE_MIN+1;
+ }
+ goto parseOK;
+ }
+ }
+ goto parseError;
}
+ if ((length < 3) || (length == 4) || (strncmp(bytes, "end", 3) != 0)) {
+ /* Doesn't start with "end" */
+ goto parseError;
+ }
if (length > 4) {
- ClientData cd;
int t;
/* Parse for the "end-..." or "end+..." formats */
if ((bytes[3] != '-') && (bytes[3] != '+')) {
/* No operator where we need one */
- return TCL_ERROR;
+ goto parseError;
}
if (TclIsSpaceProc(bytes[4])) {
/* Space after + or - not permitted. */
- return TCL_ERROR;
+ goto parseError;
}
/* Parse the integer offset */
if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
/* Not a recognized integer format */
- return TCL_ERROR;
+ goto parseError;
}
/* Got an integer offset; pull it from where parser left it. */
@@ -3920,9 +3922,17 @@ GetEndOffsetFromObj(
if (bytes[3] == '-') {
offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset;
}
+ if (offset == 1) {
+ offset = WIDE_MAX; /* "end+1" */
+ } else if (offset > 1) {
+ offset = WIDE_MAX - 1; /* "end+n", out of range */
+ } else if (offset != WIDE_MIN) {
+ offset--;
+ }
}
}
+ parseOK:
/* Success. Store the new internal rep. */
ir.wideValue = offset;
Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
@@ -3930,17 +3940,37 @@ GetEndOffsetFromObj(
offset = irPtr->wideValue;
- if (endValue == (size_t)-1) {
- *widePtr = offset - 1;
+ if (offset == WIDE_MAX) {
+ *widePtr = endValue + 1;
+ } else if (offset == WIDE_MIN) {
+ *widePtr = -1;
+ } else if (endValue == (size_t)-1) {
+ *widePtr = offset;
} else if (offset < 0) {
- /* Different signs, sum cannot overflow */
- *widePtr = endValue + offset;
- } else if (endValue < (Tcl_WideUInt)WIDE_MAX - offset) {
- *widePtr = endValue + offset;
+ /* Different signs, sum cannot overflow */
+ *widePtr = endValue + offset + 1;
+ } else if (offset < WIDE_MAX) {
+ *widePtr = offset;
} else {
- *widePtr = WIDE_MAX;
+ *widePtr = WIDE_MAX;
}
return TCL_OK;
+
+ /* Report a parse error. */
+ parseError:
+ if (interp != NULL) {
+ char * bytes = TclGetString(objPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be integer?[+-]integer? or"
+ " end?[+-]integer?", bytes));
+ if (!strncmp(bytes, "end-", 4)) {
+ bytes += 4;
+ }
+ TclCheckBadOctal(interp, bytes);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+ }
+
+ return TCL_ERROR;
}
/*
@@ -4006,52 +4036,32 @@ TclIndexEncode(
int after, /* Value to return for index after end */
int *indexPtr) /* Where to write the encoded answer, not NULL */
{
- ClientData cd;
Tcl_WideInt wide;
- int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
-
- if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) {
- /* We parsed a value in the range WIDE_MIN...WIDE_MAX */
- wide = (*(Tcl_WideInt *)cd);
- integerEncode:
- if (wide < TCL_INDEX_START) {
- /* All negative absolute indices are "before the beginning" */
- idx = before;
- } else if (wide >= INT_MAX) {
- /* This index value is always "after the end" */
- idx = after;
- } else {
- idx = (int) wide;
- }
- /* usual case, the absolute index value encodes itself */
- } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) {
- /*
- * We parsed an end+offset index value.
- * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
- */
- if (wide > 0) {
- /*
- * All end+postive or end-negative expressions
- * always indicate "after the end".
- */
- idx = after;
- } else if (wide < INT_MIN - TCL_INDEX_END) {
- /* These indices always indicate "before the beginning */
- idx = before;
- } else {
- /* Encoded end-positive (or end+negative) are offset */
- idx = (int)wide + TCL_INDEX_END;
- }
+ int idx;
- /* TODO: Consider flag to suppress repeated end-offset parse. */
- } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) {
- /*
- * Only reach this case when the index value is a
- * constant index arithmetic expression, and wide
- * holds the result. Treat it the same as if it were
- * parsed as an absolute integer value.
- */
- goto integerEncode;
+ if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &endOffsetType);
+ if (irPtr && irPtr->wideValue >= 0) {
+ /* "int[+-]int" syntax, works the same here as "int" */
+ irPtr = NULL;
+ }
+ /*
+ * We parsed an end+offset index value.
+ * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
+ */
+ if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
+ /*
+ * All end+postive or end-negative expressions
+ * always indicate "after the end".
+ */
+ idx = after;
+ } else if (wide <= (irPtr ? INT_MAX : TCL_INDEX_NONE)) {
+ /* These indices always indicate "before the beginning */
+ idx = before;
+ } else {
+ /* Encoded end-positive (or end+negative) are offset */
+ idx = (int)wide;
+ }
} else {
return TCL_ERROR;
}
@@ -4353,8 +4363,8 @@ TclGetProcessGlobalValue(
if (pgvPtr->encoding != current) {
/*
- * The system encoding has changed since the master string value
- * was saved. Convert the master value to be based on the new
+ * The system encoding has changed since the global string value
+ * was saved. Convert the global value to be based on the new
* system encoding.
*/
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 72724a4..2818fc9 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -2322,7 +2322,7 @@ TclPtrIncrObjVarIdx(
VarHashRefCount(varPtr)--;
}
if (varValuePtr == NULL) {
- varValuePtr = Tcl_NewIntObj(0);
+ TclNewIntObj(varValuePtr, 0);
}
if (Tcl_IsShared(varValuePtr)) {
/* Copy on write */
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 6c6f850..e90f286 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -26,10 +26,17 @@
#ifndef MAP_FILE
#define MAP_FILE 0
#endif /* !MAP_FILE */
+#define NOBYFOUR
+#define crc32tab crc_table[0]
+#ifndef TBLS
+#define TBLS 1
+#endif
#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
+#include "zutil.h"
+#include "crc32.h"
#ifdef CFG_RUNTIME_DLLFILE
@@ -289,70 +296,6 @@ static const char pwrot[17] =
"\x00\x80\x40\xC0\x20\xA0\x60\xE0"
"\x10\x90\x50\xD0\x30\xB0\x70\xF0";
-/*
- * Table to compute CRC32.
- */
-#ifdef Z_U4
- typedef Z_U4 z_crc_t;
-#else
- typedef unsigned long z_crc_t;
-#endif
-
-static const z_crc_t crc32tab[256] = {
- 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
- 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
- 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
- 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
- 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
- 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
- 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
- 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
- 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
- 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
- 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
- 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
- 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
- 0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
- 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
- 0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
- 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
- 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
- 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
- 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
- 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
- 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
- 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
- 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
- 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
- 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
- 0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
- 0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
- 0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
- 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
- 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
- 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
- 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
- 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
- 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
- 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
- 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
- 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
- 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
- 0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
- 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
- 0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
- 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
- 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
- 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
- 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
- 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
- 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
- 0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
- 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
- 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
- 0x2d02ef8d,
-};
-
static const char *zipfs_literal_tcl_library = NULL;
/* Function prototypes */
@@ -2244,16 +2187,15 @@ ZipAddFile(
return TCL_ERROR;
}
ch = (int) (r * 256);
- kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp);
+ kvbuf[i + 12] = UCHAR(zencode(keys, crc32tab, ch, tmp));
}
Tcl_ResetResult(interp);
init_keys(passwd, keys, crc32tab);
for (i = 0; i < 12 - 2; i++) {
- kvbuf[i] = (unsigned char)
- zencode(keys, crc32tab, kvbuf[i + 12], tmp);
+ kvbuf[i] = UCHAR(zencode(keys, crc32tab, kvbuf[i + 12], tmp));
}
- kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp);
- kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp);
+ kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 16, tmp));
+ kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 24, tmp));
len = Tcl_Write(out, (char *) kvbuf, 12);
memset(kvbuf, 0, 24);
if (len != 12) {
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 7f8d007..40aa20f 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -110,7 +110,7 @@ typedef struct {
int format; /* What format of data is going on the wire.
* Needed so that the correct [fconfigure]
* options can be enabled. */
- int readAheadLimit; /* The maximum number of bytes to read from
+ unsigned int readAheadLimit;/* The maximum number of bytes to read from
* the underlying stream in one go. */
z_stream inStream; /* Structure used by zlib for decompression of
* input. */
@@ -124,7 +124,6 @@ typedef struct {
GzipHeader outHeader; /* Header to write to an output stream, when
* compressing a gzip stream. */
Tcl_TimerToken timer; /* Timer used for keeping events fresh. */
- Tcl_DString decompressed; /* Buffer for decompression results. */
Tcl_Obj *compDictObj; /* Byte-array object containing compression
* dictionary (not dictObj!) to use if
* necessary. */
@@ -137,11 +136,15 @@ typedef struct {
* the input compressor.
* OUT_HEADER - Whether the outputHeader field has been registered
* with the output decompressor.
+ * STREAM_DECOMPRESS - Signal decompress pending data.
+ * STREAM_DONE - Flag to signal stream end up to transform input.
*/
-#define ASYNC 0x1
-#define IN_HEADER 0x2
-#define OUT_HEADER 0x4
+#define ASYNC 0x01
+#define IN_HEADER 0x02
+#define OUT_HEADER 0x04
+#define STREAM_DECOMPRESS 0x08
+#define STREAM_DONE 0x10
/*
* Size of buffers allocated by default, and the range it can be set to. The
@@ -184,10 +187,8 @@ static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
GzipHeader *headerPtr, int *extraSizePtr);
static int ZlibPushSubcmd(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static inline int ResultCopy(ZlibChannelData *cd, char *buf,
- int toRead);
-static int ResultGenerate(ZlibChannelData *cd, int n, int flush,
- int *errorCodePtr);
+static int ResultDecompress(ZlibChannelData *cd, char *buf,
+ int toRead, int flush, int *errorCodePtr);
static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
int mode, int format, int level, int limit,
Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
@@ -2399,7 +2400,7 @@ ZlibPushSubcmd(
const char *const *pushOptions = pushDecompressOptions;
enum pushOptions {poDictionary, poHeader, poLevel, poLimit};
Tcl_Obj *headerObj = NULL, *compDictObj = NULL;
- int limit = 1, dummy;
+ int limit = DEFAULT_BUFFER_SIZE, dummy;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
@@ -2995,6 +2996,15 @@ ZlibTransformClose(
} while (e != Z_STREAM_END);
(void) deflateEnd(&cd->outStream);
} else {
+ /*
+ * If we have unused bytes from the read input (overshot by
+ * Z_STREAM_END or on possible error), unget them back to the parent
+ * channel, so that they appear as not being read yet.
+ */
+ if (cd->inStream.avail_in) {
+ Tcl_Ungets (cd->parent, (char *)cd->inStream.next_in, cd->inStream.avail_in, 0);
+ }
+
(void) inflateEnd(&cd->inStream);
}
@@ -3006,7 +3016,6 @@ ZlibTransformClose(
Tcl_DecrRefCount(cd->compDictObj);
cd->compDictObj = NULL;
}
- Tcl_DStringFree(&cd->decompressed);
if (cd->inBuffer) {
ckfree(cd->inBuffer);
@@ -3040,7 +3049,7 @@ ZlibTransformInput(
ZlibChannelData *cd = (ZlibChannelData *)instanceData;
Tcl_DriverInputProc *inProc =
Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
- int readBytes, gotBytes, copied;
+ int readBytes, gotBytes;
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
@@ -3048,35 +3057,42 @@ ZlibTransformInput(
}
gotBytes = 0;
- while (toRead > 0) {
+ readBytes = cd->inStream.avail_in; /* how many bytes in buffer now */
+ while (!(cd->flags & STREAM_DONE) && toRead > 0) {
+ unsigned int n; int decBytes;
+
+ /* if starting from scratch or continuation after full decompression */
+ if (!cd->inStream.avail_in) {
+ /* buffer to start, we can read to whole available buffer */
+ cd->inStream.next_in = (Bytef *) cd->inBuffer;
+ }
/*
- * Loop until the request is satisfied (or no data available from
- * below, possibly EOF).
+ * If done - no read needed anymore, check we have to copy rest of
+ * decompressed data, otherwise return with size (or 0 for Eof)
*/
-
- copied = ResultCopy(cd, buf, toRead);
- toRead -= copied;
- buf += copied;
- gotBytes += copied;
-
- if (toRead == 0) {
- return gotBytes;
+ if (cd->flags & STREAM_DECOMPRESS) {
+ goto copyDecompressed;
}
-
/*
* The buffer is exhausted, but the caller wants even more. We now
* have to go to the underlying channel, get more bytes and then
* transform them for delivery. We may not get what we want (full EOF
* or temporarily out of data).
- *
- * Length (cd->decompressed) == 0, toRead > 0 here.
- *
- * The zlib transform allows us to read at most one character from the
- * underlying channel to properly identify Z_STREAM_END without
- * reading over the border.
*/
- readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);
+ /* Check free buffer size and adjust size of next chunk to read. */
+ n = cd->inAllocated - ((char *)cd->inStream.next_in - cd->inBuffer);
+ if (n <= 0) {
+ /* Normally unreachable: not enough input buffer to uncompress.
+ * Todo: firstly try to realloc inBuffer upto MAX_BUFFER_SIZE.
+ */
+ *errorCodePtr = ENOBUFS;
+ return -1;
+ }
+ if (n > cd->readAheadLimit) {
+ n = cd->readAheadLimit;
+ }
+ readBytes = Tcl_ReadRaw(cd->parent, (char *)cd->inStream.next_in, n);
/*
* Three cases here:
@@ -3092,45 +3108,59 @@ ZlibTransformInput(
/* See ReflectInput() in tclIORTrans.c */
if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
- return gotBytes;
+ break;
}
*errorCodePtr = Tcl_GetErrno();
return -1;
}
- if (readBytes == 0) {
- /*
- * Eof in parent.
- *
- * Now this is a bit different. The partial data waiting is
- * converted and returned.
- */
- if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) {
- return -1;
- }
+ /* more bytes (or Eof if readBytes == 0) */
+ cd->inStream.avail_in += readBytes;
- if (Tcl_DStringLength(&cd->decompressed) == 0) {
- /*
- * The drain delivered nothing. Time to deliver what we've
- * got.
- */
+copyDecompressed:
- return gotBytes;
- }
- } else /* readBytes > 0 */ {
+ /*
+ * Transform the read chunk, if not empty. Anything we get
+ * back is a transformation result to be put into our buffers, and
+ * the next iteration will put it into the result.
+ * For the case readBytes is 0 which signaling Eof in parent, the
+ * partial data waiting is converted and returned.
+ */
+
+ decBytes = ResultDecompress(cd, buf, toRead,
+ (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH,
+ errorCodePtr);
+ if (decBytes == -1) {
+ return -1;
+ }
+ gotBytes += decBytes;
+ buf += decBytes;
+ toRead -= decBytes;
+
+ if (((decBytes == 0) || (cd->flags & STREAM_DECOMPRESS))) {
/*
- * Transform the read chunk, which was not empty. Anything we get
- * back is a transformation result to be put into our buffers, and
- * the next iteration will put it into the result.
+ * The drain delivered nothing (or buffer too small to decompress).
+ * Time to deliver what we've got.
*/
-
- if (ResultGenerate(cd, readBytes, Z_NO_FLUSH,
- errorCodePtr) != TCL_OK) {
+ if (!gotBytes && !(cd->flags & STREAM_DONE)) {
+ /* if no-data, but not ready - avoid signaling Eof,
+ * continue in blocking mode, otherwise EAGAIN */
+ if (Tcl_InputBlocked(cd->parent)) {
+ continue;
+ }
+ *errorCodePtr = EAGAIN;
return -1;
}
+ break;
}
+
+ /*
+ * Loop until the request is satisfied (or no data available from
+ * above, possibly EOF).
+ */
}
+
return gotBytes;
}
@@ -3516,7 +3546,7 @@ ZlibTransformWatch(
watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
- if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) {
+ if (!(mask & TCL_READABLE) || !(cd->flags & STREAM_DECOMPRESS)) {
ZlibTransformEventTimerKill(cd);
} else if (cd->timer == NULL) {
cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
@@ -3702,6 +3732,9 @@ ZlibStackChannelTransform(
goto error;
}
cd->inAllocated = DEFAULT_BUFFER_SIZE;
+ if (cd->inAllocated < cd->readAheadLimit) {
+ cd->inAllocated = cd->readAheadLimit;
+ }
cd->inBuffer = (char *)ckalloc(cd->inAllocated);
if (cd->flags & IN_HEADER) {
if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
@@ -3732,8 +3765,6 @@ ZlibStackChannelTransform(
}
}
- Tcl_DStringInit(&cd->decompressed);
-
chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
Tcl_GetChannelMode(channel), channel);
if (chan == NULL) {
@@ -3763,96 +3794,37 @@ ZlibStackChannelTransform(
/*
*----------------------------------------------------------------------
*
- * ResultCopy --
- *
- * Copies the requested number of bytes from the buffer into the
- * specified array and removes them from the buffer afterward. Copies
- * less if there is not enough data in the buffer.
- *
- * Side effects:
- * See above.
- *
- * Result:
- * The number of actually copied bytes, possibly less than 'toRead'.
- *
- *----------------------------------------------------------------------
- */
-
-static inline int
-ResultCopy(
- ZlibChannelData *cd, /* The location of the buffer to read from. */
- char *buf, /* The buffer to copy into */
- int toRead) /* Number of requested bytes */
-{
- int have = Tcl_DStringLength(&cd->decompressed);
-
- if (have == 0) {
- /*
- * Nothing to copy in the case of an empty buffer.
- */
-
- return 0;
- } else if (have > toRead) {
- /*
- * The internal buffer contains more than requested. Copy the
- * requested subset to the caller, shift the remaining bytes down, and
- * truncate.
- */
-
- char *src = Tcl_DStringValue(&cd->decompressed);
-
- memcpy(buf, src, toRead);
- memmove(src, src + toRead, have - toRead);
-
- Tcl_DStringSetLength(&cd->decompressed, have - toRead);
- return toRead;
- } else /* have <= toRead */ {
- /*
- * There is just or not enough in the buffer to fully satisfy the
- * caller, so take everything as best effort.
- */
-
- memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
- TclDStringClear(&cd->decompressed);
- return have;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ResultGenerate --
+ * ResultDecompress --
*
* Extract uncompressed bytes from the compression engine and store them
- * in our working buffer.
+ * in our buffer (buf) up to toRead bytes.
*
* Result:
- * TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason).
+ * Number of bytes decompressed or -1 if error (with *errorCodePtr updated with reason).
*
* Side effects:
- * See above.
+ * After execution it updates cd->inStream (next_in, avail_in) to reflect
+ * the data that has been decompressed.
*
*----------------------------------------------------------------------
*/
static int
-ResultGenerate(
+ResultDecompress(
ZlibChannelData *cd,
- int n,
+ char *buf,
+ int toRead,
int flush,
int *errorCodePtr)
{
-#define MAXBUF 1024
- unsigned char buf[MAXBUF];
- int e, written;
+ int e, written, resBytes = 0;
Tcl_Obj *errObj;
- cd->inStream.next_in = (Bytef *) cd->inBuffer;
- cd->inStream.avail_in = n;
- while (1) {
- cd->inStream.next_out = (Bytef *) buf;
- cd->inStream.avail_out = MAXBUF;
+ cd->flags &= ~STREAM_DECOMPRESS;
+ cd->inStream.next_out = (Bytef *) buf;
+ cd->inStream.avail_out = toRead;
+ while (cd->inStream.avail_out > 0) {
e = inflate(&cd->inStream, flush);
if (e == Z_NEED_DICT && cd->compDictObj) {
@@ -3861,31 +3833,35 @@ ResultGenerate(
/*
* A repetition of Z_NEED_DICT is just an error.
*/
-
- cd->inStream.next_out = (Bytef *) buf;
- cd->inStream.avail_out = MAXBUF;
e = inflate(&cd->inStream, flush);
}
}
/*
* avail_out is now the left over space in the output. Therefore
- * "MAXBUF - avail_out" is the amount of bytes generated.
+ * "toRead - avail_out" is the amount of bytes generated.
*/
- written = MAXBUF - cd->inStream.avail_out;
- if (written) {
- Tcl_DStringAppend(&cd->decompressed, (char *) buf, written);
- }
+ written = toRead - cd->inStream.avail_out;
/*
* The cases where we're definitely done.
*/
- if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR))
- || (e == Z_STREAM_END)
- || (e == Z_OK && written == 0)) {
- return TCL_OK;
+ if (e == Z_STREAM_END) {
+ cd->flags |= STREAM_DONE;
+ resBytes += written;
+ break;
+ }
+ if (e == Z_OK) {
+ if (written == 0) {
+ break;
+ }
+ resBytes += written;
+ }
+
+ if ((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) {
+ break;
}
/*
@@ -3906,10 +3882,20 @@ ResultGenerate(
*/
if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
- return TCL_OK;
+ break;
}
}
+ if (!(cd->flags & STREAM_DONE)) {
+ /* if we have pending input data, but no available output buffer */
+ if (cd->inStream.avail_in && !cd->inStream.avail_out) {
+ /* next time try to decompress it got readable (new output buffer) */
+ cd->flags |= STREAM_DECOMPRESS;
+ }
+ }
+
+ return resBytes;
+
handleError:
errObj = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
@@ -3919,7 +3905,7 @@ ResultGenerate(
Tcl_NewStringObj(cd->inStream.msg, -1));
Tcl_SetChannelError(cd->parent, errObj);
*errorCodePtr = EINVAL;
- return TCL_ERROR;
+ return -1;
}
/*
diff --git a/library/auto.tcl b/library/auto.tcl
index 7ef5681..2deae05 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -427,10 +427,10 @@ proc auto_mkindex_parser::mkindex {file} {
# auto_mkindex_parser::hook command
#
-# Registers a Tcl command to evaluate when initializing the slave interpreter
-# used by the mkindex parser. The command is evaluated in the master
+# Registers a Tcl command to evaluate when initializing the child interpreter
+# used by the mkindex parser. The command is evaluated in the parent
# interpreter, and can use the variable auto_mkindex_parser::parser to get to
-# the slave
+# the child
proc auto_mkindex_parser::hook {cmd} {
variable initCommands
@@ -438,16 +438,16 @@ proc auto_mkindex_parser::hook {cmd} {
lappend initCommands $cmd
}
-# auto_mkindex_parser::slavehook command
+# auto_mkindex_parser::childhook command
#
-# Registers a Tcl command to evaluate when initializing the slave interpreter
-# used by the mkindex parser. The command is evaluated in the slave
+# Registers a Tcl command to evaluate when initializing the child interpreter
+# used by the mkindex parser. The command is evaluated in the child
# interpreter.
-proc auto_mkindex_parser::slavehook {cmd} {
+proc auto_mkindex_parser::childhook {cmd} {
variable initCommands
- # The $parser variable is defined to be the name of the slave interpreter
+ # The $parser variable is defined to be the name of the child interpreter
# when this command is used later.
lappend initCommands "\$parser eval [list $cmd]"
@@ -601,7 +601,7 @@ auto_mkindex_parser::command proc {name args} {
# Conditionally add support for Tcl byte code files. There are some tricky
# details here. First, we need to get the tbcload library initialized in the
-# current interpreter. We cannot load tbcload into the slave until we have
+# current interpreter. We cannot load tbcload into the child until we have
# done so because it needs access to the tcl_patchLevel variable. Second,
# because the package index file may defer loading the library until we invoke
# a command, we need to explicitly invoke auto_load to force it to be loaded.
diff --git a/library/clock.tcl b/library/clock.tcl
index 49dfdbe..2e42a98 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -3304,7 +3304,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
return
}
- # Since an unsafe interp uses the [clock] command in the master, this code
+ # Since an unsafe interp uses the [clock] command in the parent, this code
# is security sensitive. Make sure that the path name cannot escape the
# given directory.
@@ -3344,7 +3344,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
proc ::tcl::clock::LoadZoneinfoFile { fileName } {
variable ZoneinfoPaths
- # Since an unsafe interp uses the [clock] command in the master, this code
+ # Since an unsafe interp uses the [clock] command in the parent, this code
# is security sensitive. Make sure that the path name cannot escape the
# given directory.
diff --git a/library/cookiejar/cookiejar.tcl b/library/cookiejar/cookiejar.tcl
index c8b495a..6c8e82b 100644
--- a/library/cookiejar/cookiejar.tcl
+++ b/library/cookiejar/cookiejar.tcl
@@ -98,7 +98,8 @@ namespace eval [info object namespace ::http::cookiejar] {
}
proc splitPath path {
set pieces [split [string trimleft $path "/"] "/"]
- for {set j -1} {$j < [llength $pieces]} {incr j} {
+ set result /
+ for {set j 0} {$j < [llength $pieces]} {incr j} {
lappend result /[join [lrange $pieces 0 $j] "/"]
}
return $result
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index e8917ac..a87db33 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,3 @@
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
-if {[::tcl::pkgconfig get debug]} {
- package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] dde]
-} else {
- package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
-}
+package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
diff --git a/library/http/http.tcl b/library/http/http.tcl
index baa3caa..21d6671 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.1
+package provide http 2.9.5
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -544,7 +544,7 @@ proc http::CloseSocket {s {token {}}} {
} else {
set map [array get socketMapping]
set ndx [lsearch -exact $map $s]
- if {$ndx != -1} {
+ if {$ndx >= 0} {
incr ndx -1
set connId [lindex $map $ndx]
}
@@ -734,7 +734,7 @@ proc http::geturl {url args} {
body {}
status ""
http ""
- connection close
+ connection keep-alive
}
set state(-keepalive) $defaultKeepalive
set state(-strict) $strict
@@ -983,6 +983,18 @@ proc http::geturl {url args} {
set state(-pipeline) $http(-pipeline)
}
+ # We cannot handle chunked encodings with -handler, so force HTTP/1.0
+ # until we can manage this.
+ if {[info exists state(-handler)]} {
+ set state(-protocol) 1.0
+ }
+
+ # RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it.
+ if {$state(-protocol) eq "1.0"} {
+ set state(connection) close
+ set state(-keepalive) 0
+ }
+
# See if we are supposed to use a previously opened channel.
# - In principle, ANY call to http::geturl could use a previously opened
# channel if it is available - the "Connection: keep-alive" header is a
@@ -1054,7 +1066,7 @@ proc http::geturl {url args} {
}
# Do not automatically close the connection socket.
- set state(connection) {}
+ set state(connection) keep-alive
}
}
@@ -1349,19 +1361,12 @@ proc http::Connected {token proto phost srvurl} {
set how POST
# The query channel must be blocking for the async Write to
# work properly.
- lassign [fconfigure $sock -translation] trRead trWrite
- fconfigure $state(-querychannel) -blocking 1 \
- -translation [list $trRead binary]
+ fconfigure $state(-querychannel) -blocking 1 -translation binary
set contDone 0
}
if {[info exists state(-method)] && ($state(-method) ne "")} {
set how $state(-method)
}
- # We cannot handle chunked encodings with -handler, so force HTTP/1.0
- # until we can manage this.
- if {[info exists state(-handler)]} {
- set state(-protocol) 1.0
- }
set accept_types_seen 0
Log ^B$tk begin sending request - token $token
@@ -1384,7 +1389,7 @@ proc http::Connected {token proto phost srvurl} {
puts $sock "Host: $host:$port"
}
puts $sock "User-Agent: $http(-useragent)"
- if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
+ if {($state(-protocol) > 1.0) && $state(-keepalive)} {
# Send this header, because a 1.1 server is not compelled to treat
# this as the default.
puts $sock "Connection: keep-alive"
@@ -1392,9 +1397,17 @@ proc http::Connected {token proto phost srvurl} {
if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
}
- if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
- puts $sock "Proxy-Connection: Keep-Alive"
- }
+ if {($state(-protocol) < 1.1)} {
+ # RFC7230 A.1
+ # Some server implementations of HTTP/1.0 have a faulty
+ # implementation of RFC 2068 Keep-Alive.
+ # Don't leave this to chance.
+ # For HTTP/1.0 we have already "set state(connection) close"
+ # and "state(-keepalive) 0".
+ puts $sock "Connection: close"
+ }
+ # RFC7230 A.1 - "clients are encouraged not to send the
+ # Proxy-Connection header field in any requests"
set accept_encoding_seen 0
set content_type_seen 0
dict for {key value} $state(-headers) {
@@ -1670,9 +1683,51 @@ proc http::ReceiveResponse {token} {
Log ^D$tk begin receiving response - token $token
coroutine ${token}EventCoroutine http::Event $sock $token
- fileevent $sock readable ${token}EventCoroutine
+ if {[info exists state(-handler)] || [info exists state(-progress)]} {
+ fileevent $sock readable [list http::EventGateway $sock $token]
+ } else {
+ fileevent $sock readable ${token}EventCoroutine
+ }
+ return
+}
+
+
+# http::EventGateway
+#
+# Bug [c2dc1da315].
+# - Recursive launch of the coroutine can occur if a -handler or -progress
+# callback is used, and the callback command enters the event loop.
+# - To prevent this, the fileevent "binding" is disabled while the
+# coroutine is in flight.
+# - If a recursive call occurs despite these precautions, it is not
+# trapped and discarded here, because it is better to report it as a
+# bug.
+# - Although this solution is believed to be sufficiently general, it is
+# used only if -handler or -progress is specified. In other cases,
+# the coroutine is called directly.
+
+proc http::EventGateway {sock token} {
+ variable $token
+ upvar 0 $token state
+ fileevent $sock readable {}
+ catch {${token}EventCoroutine} res opts
+ if {[info commands ${token}EventCoroutine] ne {}} {
+ # The coroutine can be deleted by completion (a non-yield return), by
+ # http::Finish (when there is a premature end to the transaction), by
+ # http::reset or http::cleanup, or if the caller set option -channel
+ # but not option -handler: in the last case reading from the socket is
+ # now managed by commands ::http::Copy*, http::ReceiveChunked, and
+ # http::make-transformation-chunked.
+ #
+ # Catch in case the coroutine has closed the socket.
+ catch {fileevent $sock readable [list http::EventGateway $sock $token]}
+ }
+
+ # If there was an error, re-throw it.
+ return -options $opts $res
}
+
# http::NextPipelinedWrite
#
# - Connecting a socket to a token for writing is done by this command and by
@@ -2727,8 +2782,32 @@ proc http::Event {sock token} {
}
proxy-connection -
connection {
- set state(connection) \
- [string trim [string tolower $value]]
+ set tmpHeader [string trim [string tolower $value]]
+ # RFC 7230 Section 6.1 states that a comma-separated
+ # list is an acceptable value. According to
+ # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
+ # any comma-separated list implies keep-alive, but I
+ # don't see this in the RFC so we'll play safe and
+ # scan any list for "close".
+ if {$tmpHeader in {close keep-alive}} {
+ # The common cases, continue.
+ } elseif {[string first , $tmpHeader] < 0} {
+ # Not a comma-separated list, not "close",
+ # therefore "keep-alive".
+ set tmpHeader keep-alive
+ } else {
+ set tmpResult keep-alive
+ set tmpCsl [split $tmpHeader ,]
+ # Optional whitespace either side of separator.
+ foreach el $tmpCsl {
+ if {[string trim $el] eq {close}} {
+ set tmpResult close
+ break
+ }
+ }
+ set tmpHeader $tmpResult
+ }
+ set state(connection) $tmpHeader
}
set-cookie {
if {$http(-cookiejar) ne ""} {
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index f9f1176..74c4841 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.1 [list tclPkgSetup $dir http 2.9.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.9.5 [list tclPkgSetup $dir http 2.9.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/init.tcl b/library/init.tcl
index 4ea22d8..94f65cf 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -40,41 +40,46 @@ package require -exact Tcl 8.7a4
# tcl_pkgPath, which is set by the platform-specific initialization routines
# On UNIX it is compiled in
# On Windows, it is not used
+#
+# (Ticket 41c9857bdd) In a safe interpreter, this file does not set
+# ::auto_path (other than to {} if it is undefined). The caller, typically
+# a Safe Base command, is responsible for setting ::auto_path.
if {![info exists auto_path]} {
- if {[info exists env(TCLLIBPATH)]} {
+ if {[info exists env(TCLLIBPATH)] && (![interp issafe])} {
set auto_path $env(TCLLIBPATH)
} else {
set auto_path ""
}
}
namespace eval tcl {
- variable Dir
- foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
- if {$Dir ni $::auto_path} {
- lappend ::auto_path $Dir
- }
- }
- set Dir [file join [file dirname [file dirname \
- [info nameofexecutable]]] lib]
- if {$Dir ni $::auto_path} {
- lappend ::auto_path $Dir
- }
- if {[info exists ::tcl_pkgPath]} { catch {
- foreach Dir $::tcl_pkgPath {
+ if {![interp issafe]} {
+ variable Dir
+ foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
if {$Dir ni $::auto_path} {
lappend ::auto_path $Dir
}
}
- }}
+ set Dir [file join [file dirname [file dirname \
+ [info nameofexecutable]]] lib]
+ if {$Dir ni $::auto_path} {
+ lappend ::auto_path $Dir
+ }
+ if {[info exists ::tcl_pkgPath]} { catch {
+ foreach Dir $::tcl_pkgPath {
+ if {$Dir ni $::auto_path} {
+ lappend ::auto_path $Dir
+ }
+ }
+ }}
- if {![interp issafe]} {
- variable Path [encoding dirs]
- set Dir [file join $::tcl_library encoding]
- if {$Dir ni $Path} {
+ variable Path [encoding dirs]
+ set Dir [file join $::tcl_library encoding]
+ if {$Dir ni $Path} {
lappend Path $Dir
encoding dirs $Path
- }
+ }
+ unset Dir Path
}
}
@@ -240,7 +245,7 @@ proc unknown args {
set errInfo [string range $errInfo 0 $last-1]
set tail "\"$cinfo\""
set last [string last $tail $errInfo]
- if {$last + [string length $tail] != [string length $errInfo]} {
+ if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} {
return -code error -errorcode $errCode \
-errorinfo $errInfo $msg
}
@@ -737,7 +742,7 @@ proc tcl::CopyDirectory {action src dest} {
}
}
} else {
- if {[string first $nsrc $ndest] != -1} {
+ if {[string first $nsrc $ndest] >= 0} {
set srclen [expr {[llength [file split $nsrc]] - 1}]
set ndest [lindex [file split $ndest] $srclen]
if {$ndest eq [file tail $nsrc]} {
diff --git a/library/install.tcl b/library/install.tcl
index e62226e..227d0b8 100644
--- a/library/install.tcl
+++ b/library/install.tcl
@@ -104,7 +104,7 @@ proc ::practcl::_pkgindex_directory {path} {
}
if {![regexp "package.*ifneeded" $thisline]} {
# This package index contains arbitrary code
- # source instead of trying to add it to the master
+ # source instead of trying to add it to the main
# package index
if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
return {source [file join $dir pkgIndex.tcl]}
diff --git a/library/manifest.txt b/library/manifest.txt
index 407cd88..c9cbe5b 100644
--- a/library/manifest.txt
+++ b/library/manifest.txt
@@ -5,9 +5,9 @@ apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
- 0 http 2.9.1 {http http.tcl}
- 1 msgcat 1.7.0 {msgcat msgcat.tcl}
- 1 opt 0.4.7 {opt optparse.tcl}
+ 0 http 2.9.5 {http http.tcl}
+ 1 msgcat 1.7.1 {msgcat msgcat.tcl}
+ 1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
0 tcl::idna 1.0.1 {cookiejar idna.tcl}
0 platform 1.0.14 {platform platform.tcl}
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 9f7d54a..b488b9c 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -15,7 +15,7 @@
package require Tcl 8.7-
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.7.0
+package provide msgcat 1.7.1
namespace eval msgcat {
namespace export mc mcn mcexists mcload mclocale mcmax\
@@ -360,17 +360,19 @@ proc msgcat::mclocale {args} {
proc msgcat::mcutil::getpreferences {locale} {
set locale [string tolower $locale]
- set loclist [list $locale]
- while {-1 !=[set pos [string last "_" $locale]]} {
- set locale [string range $locale 0 $pos-1]
- if { "_" ne [string index $locale end] } {
- lappend loclist $locale
+ set result [list {}]
+ set el {}
+ foreach e [split $locale _] {
+ if {$el eq {}} {
+ set el ${e}
+ } else {
+ set el ${el}_${e}
+ }
+ if {[string index $el end] != {_}} {
+ set result [linsert $result 0 $el]
}
}
- if {"" ne [lindex $loclist end]} {
- lappend loclist {}
- }
- return $loclist
+ return $result
}
# msgcat::mcpreferences --
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 3309a30..18bd71b 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.7-]} {return}
-package ifneeded msgcat 1.7.0 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.7.1 [list source [file join $dir msgcat.tcl]]
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index c8946fd..1639379 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.5-
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
-package provide opt 0.4.7
+package provide opt 0.4.8
namespace eval ::tcl {
@@ -44,8 +44,8 @@ namespace eval ::tcl {
{-intflag 7}
{-weirdflag "help string"}
{-noStatics "Not ok to load static packages"}
- {-nestedloading1 true "OK to load into nested slaves"}
- {-nestedloading2 -boolean true "OK to load into nested slaves"}
+ {-nestedloading1 true "OK to load into nested children"}
+ {-nestedloading2 -boolean true "OK to load into nested children"}
{-libsOK -choice {Tk SybTcl}
"List of packages that can be loaded"}
{-precision -int 12 "Number of digits of precision"}
diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl
index daf9aa9..23e118c 100644
--- a/library/opt/pkgIndex.tcl
+++ b/library/opt/pkgIndex.tcl
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
-package ifneeded opt 0.4.7 [list source [file join $dir optparse.tcl]]
+package ifneeded opt 0.4.8 [list source [file join $dir optparse.tcl]]
diff --git a/library/package.tcl b/library/package.tcl
index 6c87ec1..eebe91c 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -237,7 +237,7 @@ proc pkg_mkIndex {args} {
$c eval [list set ::tcl::file $file]
$c eval [list set ::tcl::direct $direct]
- # Download needed procedures into the slave because we've just deleted
+ # Download needed procedures into the child because we've just deleted
# the unknown procedure. This doesn't handle procedures with default
# arguments.
@@ -479,9 +479,12 @@ proc tclPkgUnknown {name args} {
}
set tclSeenPath($dir) 1
- # we can't use glob in safe interps, so enclose the following in a
- # catch statement, where we get the pkgIndex files out of the
- # subdirectories
+ # Get the pkgIndex.tcl files in subdirectories of auto_path directories.
+ # - Safe Base interpreters have a restricted "glob" command that
+ # works in this case.
+ # - The "catch" was essential when there was no safe glob and every
+ # call in a safe interp failed; it is retained only for corner
+ # cases in which the eventual call to glob returns an error.
catch {
foreach file [glob -directory $dir -join -nocomplain \
* pkgIndex.tcl] {
@@ -593,6 +596,7 @@ proc tcl::MacOSXPkgUnknown {original name args} {
set tclSeenPath($dir) 1
# get the pkgIndex files out of the subdirectories
+ # Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl.
foreach file [glob -directory $dir -join -nocomplain \
* Resources Scripts pkgIndex.tcl] {
set dir [file dirname $file]
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index b33970d..0413df6 100755..100644
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,9 +1,4 @@
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
-if {[::tcl::pkgconfig get debug]} {
- package ifneeded registry 1.3.5 \
- [list load [file join $dir tclreg13g.dll] registry]
-} else {
- package ifneeded registry 1.3.5 \
- [list load [file join $dir tclreg13.dll] registry]
-}
+package ifneeded registry 1.3.5 \
+ [list load [file join $dir tclreg13.dll] registry]
diff --git a/library/safe.tcl b/library/safe.tcl
index 470cfa3..1f8c3d2 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -2,8 +2,8 @@
#
# This file provide a safe loading/sourcing mechanism for safe interpreters.
# It implements a virtual path mecanism to hide the real pathnames from the
-# slave. It runs in a master interpreter and sets up data structure and
-# aliases that will be invoked when used from a slave interpreter.
+# child. It runs in a parent interpreter and sets up data structure and
+# aliases that will be invoked when used from a child interpreter.
#
# See the safe.n man page for details.
#
@@ -20,7 +20,7 @@
#
# Needed utilities package
-package require opt 0.4.7
+package require opt 0.4.8
# Create the safe namespace
namespace eval ::safe {
@@ -79,25 +79,27 @@ proc ::safe::InterpNested {} {
# Interface/entry point function and front end for "Create"
proc ::safe::interpCreate {args} {
set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
- InterpCreate $slave $accessPath \
+ RejectExcessColons $child
+ InterpCreate $child $accessPath \
[InterpStatics] [InterpNested] $deleteHook
}
proc ::safe::interpInit {args} {
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
- if {![::interp exists $slave]} {
- return -code error "\"$slave\" is not an interpreter"
+ if {![::interp exists $child]} {
+ return -code error "\"$child\" is not an interpreter"
}
- InterpInit $slave $accessPath \
+ RejectExcessColons $child
+ InterpInit $child $accessPath \
[InterpStatics] [InterpNested] $deleteHook
}
-# Check that the given slave is "one of us"
-proc ::safe::CheckInterp {slave} {
- namespace upvar ::safe S$slave state
- if {![info exists state] || ![::interp exists $slave]} {
+# Check that the given child is "one of us"
+proc ::safe::CheckInterp {child} {
+ namespace upvar ::safe [VarName $child] state
+ if {![info exists state] || ![::interp exists $child]} {
return -code error \
- "\"$slave\" is not an interpreter managed by ::safe::"
+ "\"$child\" is not an interpreter managed by ::safe::"
}
}
@@ -119,11 +121,11 @@ proc ::safe::interpConfigure {args} {
1 {
# If we have exactly 1 argument the semantic is to return all
# the current configuration. We still call OptKeyParse though
- # we know that "slave" is our given argument because it also
+ # we know that "child" is our given argument because it also
# checks for the "-help" option.
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
- CheckInterp $slave
- namespace upvar ::safe S$slave state
+ CheckInterp $child
+ namespace upvar ::safe [VarName $child] state
return [join [list \
[list -accessPath $state(access_path)] \
@@ -134,7 +136,7 @@ proc ::safe::interpConfigure {args} {
2 {
# If we have exactly 2 arguments the semantic is a "configure
# get"
- lassign $args slave arg
+ lassign $args child arg
# get the flag sub program (we 'know' about Opt's internal
# representation of data)
@@ -145,8 +147,8 @@ proc ::safe::interpConfigure {args} {
} elseif {$hits == 0} {
return -code error [::tcl::OptFlagUsage $desc $arg]
}
- CheckInterp $slave
- namespace upvar ::safe S$slave state
+ CheckInterp $child
+ namespace upvar ::safe [VarName $child] state
set item [::tcl::OptCurDesc $desc]
set name [::tcl::OptName $item]
@@ -186,16 +188,16 @@ proc ::safe::interpConfigure {args} {
# Otherwise we want to parse the arguments like init and
# create did
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
- CheckInterp $slave
- namespace upvar ::safe S$slave state
+ CheckInterp $child
+ namespace upvar ::safe [VarName $child] state
# Get the current (and not the default) values of whatever has
# not been given:
if {![::tcl::OptProcArgGiven -accessPath]} {
- set doreset 1
+ set doreset 0
set accessPath $state(access_path)
} else {
- set doreset 0
+ set doreset 1
}
if {
![::tcl::OptProcArgGiven -statics]
@@ -217,15 +219,34 @@ proc ::safe::interpConfigure {args} {
set deleteHook $state(cleanupHook)
}
# we can now reconfigure :
- InterpSetConfig $slave $accessPath $statics $nested $deleteHook
- # auto_reset the slave (to completly synch the new access_path)
+ InterpSetConfig $child $accessPath $statics $nested $deleteHook
+ # auto_reset the child (to completly synch the new access_path)
if {$doreset} {
- if {[catch {::interp eval $slave {auto_reset}} msg]} {
- Log $slave "auto_reset failed: $msg"
+ if {[catch {::interp eval $child {auto_reset}} msg]} {
+ Log $child "auto_reset failed: $msg"
} else {
- Log $slave "successful auto_reset" NOTICE
+ Log $child "successful auto_reset" NOTICE
+ }
+
+ # Sync the paths used to search for Tcl modules.
+ ::interp eval $child {tcl::tm::path remove {*}[tcl::tm::list]}
+ if {[llength $state(tm_path_child)] > 0} {
+ ::interp eval $child [list \
+ ::tcl::tm::add {*}[lreverse $state(tm_path_child)]]
+ }
+
+ # Remove stale "package ifneeded" data for non-loaded packages.
+ # - Not for loaded packages, because "package forget" erases
+ # data from "package provide" as well as "package ifneeded".
+ # - This is OK because the script cannot reload any version of
+ # the package unless it first does "package forget".
+ foreach pkg [::interp eval $child {package names}] {
+ if {[::interp eval $child [list package provide $pkg]] eq ""} {
+ ::interp eval $child [list package forget $pkg]
+ }
}
}
+ return
}
}
}
@@ -239,17 +260,17 @@ proc ::safe::interpConfigure {args} {
#
# safe::InterpCreate : doing the real job
#
-# This procedure creates a safe slave and initializes it with the safe
+# This procedure creates a safe interpreter and initializes it with the safe
# base aliases.
-# NB: slave name must be simple alphanumeric string, no spaces, no (), no
+# NB: child name must be simple alphanumeric string, no spaces, no (), no
# {},... {because the state array is stored as part of the name}
#
-# Returns the slave name.
+# Returns the child name.
#
# Optional Arguments :
-# + slave name : if empty, generated name will be used
+# + child name : if empty, generated name will be used
# + access_path: path list controlling where load/source can occur,
-# if empty: the master auto_path will be used.
+# if empty: the parent auto_path will be used.
# + staticsok : flag, if 0 :no static package can be loaded (load {} Xxx)
# if 1 :static packages are ok.
# + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
@@ -257,35 +278,37 @@ proc ::safe::interpConfigure {args} {
# use the full name and no indent so auto_mkIndex can find us
proc ::safe::InterpCreate {
- slave
+ child
access_path
staticsok
nestedok
deletehook
} {
- # Create the slave.
- if {$slave ne ""} {
- ::interp create -safe $slave
+ # Create the child.
+ # If evaluated in ::safe, the interpreter command for foo is ::foo;
+ # but for foo::bar is safe::foo::bar. So evaluate in :: instead.
+ if {$child ne ""} {
+ namespace eval :: [list ::interp create -safe $child]
} else {
- # empty argument: generate slave name
- set slave [::interp create -safe]
+ # empty argument: generate child name
+ set child [::interp create -safe]
}
- Log $slave "Created" NOTICE
+ Log $child "Created" NOTICE
- # Initialize it. (returns slave name)
- InterpInit $slave $access_path $staticsok $nestedok $deletehook
+ # Initialize it. (returns child name)
+ InterpInit $child $access_path $staticsok $nestedok $deletehook
}
#
# InterpSetConfig (was setAccessPath) :
-# Sets up slave virtual auto_path and corresponding structure within
-# the master. Also sets the tcl_library in the slave to be the first
+# Sets up child virtual auto_path and corresponding structure within
+# the parent. Also sets the tcl_library in the child to be the first
# directory in the path.
-# NB: If you change the path after the slave has been initialized you
-# probably need to call "auto_reset" in the slave in order that it gets
+# NB: If you change the path after the child has been initialized you
+# probably need to call "auto_reset" in the child in order that it gets
# the right auto_index() array values.
-proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
+proc ::safe::InterpSetConfig {child access_path staticsok nestedok deletehook} {
global auto_path
# determine and store the access path if empty
@@ -295,48 +318,48 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# Make sure that tcl_library is in auto_path and at the first
# position (needed by setAccessPath)
set where [lsearch -exact $access_path [info library]]
- if {$where == -1} {
+ if {$where < 0} {
# not found, add it.
set access_path [linsert $access_path 0 [info library]]
- Log $slave "tcl_library was not in auto_path,\
- added it to slave's access_path" NOTICE
+ Log $child "tcl_library was not in auto_path,\
+ added it to child's access_path" NOTICE
} elseif {$where != 0} {
# not first, move it first
set access_path [linsert \
[lreplace $access_path $where $where] \
0 [info library]]
- Log $slave "tcl_libray was not in first in auto_path,\
- moved it to front of slave's access_path" NOTICE
+ Log $child "tcl_libray was not in first in auto_path,\
+ moved it to front of child's access_path" NOTICE
}
# Add 1st level sub dirs (will searched by auto loading from tcl
- # code in the slave using glob and thus fail, so we add them here
+ # code in the child using glob and thus fail, so we add them here
# so by default it works the same).
set access_path [AddSubDirs $access_path]
}
- Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
+ Log $child "Setting accessPath=($access_path) staticsok=$staticsok\
nestedok=$nestedok deletehook=($deletehook)" NOTICE
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $child] state
# clear old autopath if it existed
# build new one
# Extend the access list with the paths used to look for Tcl Modules.
# We save the virtual form separately as well, as syncing it with the
- # slave has to be defered until the necessary commands are present for
+ # child has to be defered until the necessary commands are present for
# setup.
set norm_access_path {}
- set slave_access_path {}
+ set child_access_path {}
set map_access_path {}
set remap_access_path {}
- set slave_tm_path {}
+ set child_tm_path {}
set i 0
foreach dir $access_path {
set token [PathToken $i]
- lappend slave_access_path $token
+ lappend child_access_path $token
lappend map_access_path $token $dir
lappend remap_access_path $dir $token
lappend norm_access_path [file normalize $dir]
@@ -344,6 +367,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
}
set morepaths [::tcl::tm::list]
+ set firstpass 1
while {[llength $morepaths]} {
set addpaths $morepaths
set morepaths {}
@@ -352,16 +376,27 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# Prevent the addition of dirs on the tm list to the
# result if they are already known.
if {[dict exists $remap_access_path $dir]} {
+ if {$firstpass} {
+ # $dir is in [::tcl::tm::list] and belongs in the child_tm_path.
+ # Later passes handle subdirectories, which belong in the
+ # access path but not in the module path.
+ lappend child_tm_path [dict get $remap_access_path $dir]
+ }
continue
}
set token [PathToken $i]
lappend access_path $dir
- lappend slave_access_path $token
+ lappend child_access_path $token
lappend map_access_path $token $dir
lappend remap_access_path $dir $token
lappend norm_access_path [file normalize $dir]
- lappend slave_tm_path $token
+ if {$firstpass} {
+ # $dir is in [::tcl::tm::list] and belongs in the child_tm_path.
+ # Later passes handle subdirectories, which belong in the
+ # access path but not in the module path.
+ lappend child_tm_path $token
+ }
incr i
# [Bug 2854929]
@@ -372,19 +407,21 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# subdirectories.
lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
}
+ set firstpass 0
}
set state(access_path) $access_path
set state(access_path,map) $map_access_path
set state(access_path,remap) $remap_access_path
set state(access_path,norm) $norm_access_path
- set state(access_path,slave) $slave_access_path
- set state(tm_path_slave) $slave_tm_path
+ set state(access_path,child) $child_access_path
+ set state(tm_path_child) $child_tm_path
set state(staticsok) $staticsok
set state(nestedok) $nestedok
set state(cleanupHook) $deletehook
- SyncAccessPath $slave
+ SyncAccessPath $child
+ return
}
#
@@ -392,11 +429,12 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# FindInAccessPath:
# Search for a real directory and returns its virtual Id (including the
# "$")
-proc ::safe::interpFindInAccessPath {slave path} {
- namespace upvar ::safe S$slave state
+proc ::safe::interpFindInAccessPath {child path} {
+ CheckInterp $child
+ namespace upvar ::safe [VarName $child] state
if {![dict exists $state(access_path,remap) $path]} {
- return -code error "$path not found in access path $access_path"
+ return -code error "$path not found in access path"
}
return [dict get $state(access_path,remap) $path]
@@ -406,10 +444,11 @@ proc ::safe::interpFindInAccessPath {slave path} {
# addToAccessPath:
# add (if needed) a real directory to access path and return its
# virtual token (including the "$").
-proc ::safe::interpAddToAccessPath {slave path} {
+proc ::safe::interpAddToAccessPath {child path} {
# first check if the directory is already in there
# (inlined interpFindInAccessPath).
- namespace upvar ::safe S$slave state
+ CheckInterp $child
+ namespace upvar ::safe [VarName $child] state
if {[dict exists $state(access_path,remap) $path]} {
return [dict get $state(access_path,remap) $path]
@@ -419,12 +458,12 @@ proc ::safe::interpAddToAccessPath {slave path} {
set token [PathToken [llength $state(access_path)]]
lappend state(access_path) $path
- lappend state(access_path,slave) $token
+ lappend state(access_path,child) $token
lappend state(access_path,map) $token $path
lappend state(access_path,remap) $path $token
lappend state(access_path,norm) [file normalize $path]
- SyncAccessPath $slave
+ SyncAccessPath $child
return $token
}
@@ -432,25 +471,25 @@ proc ::safe::interpAddToAccessPath {slave path} {
# interpreter. It is useful when you want to install the safe base aliases
# into a preexisting safe interpreter.
proc ::safe::InterpInit {
- slave
+ child
access_path
staticsok
nestedok
deletehook
} {
# Configure will generate an access_path when access_path is empty.
- InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook
+ InterpSetConfig $child $access_path $staticsok $nestedok $deletehook
# NB we need to add [namespace current], aliases are always absolute
# paths.
- # These aliases let the slave load files to define new commands
- # This alias lets the slave use the encoding names, convertfrom,
+ # These aliases let the child load files to define new commands
+ # This alias lets the child use the encoding names, convertfrom,
# convertto, and system, but not "encoding system <name>" to set the
# system encoding.
# Handling Tcl Modules, we need a restricted form of Glob.
# This alias interposes on the 'exit' command and cleanly terminates
- # the slave.
+ # the child.
foreach {command alias} {
source AliasSource
@@ -458,60 +497,60 @@ proc ::safe::InterpInit {
exit interpDelete
glob AliasGlob
} {
- ::interp alias $slave $command {} [namespace current]::$alias $slave
+ ::interp alias $child $command {} [namespace current]::$alias $child
}
# UGLY POINT! These commands are safe (they're ensembles with unsafe
# subcommands), but is assumed to not be by existing policies so it is
# hidden by default. Hack it...
foreach command {encoding file} {
- ::interp alias $slave $command {} interp invokehidden $slave $command
+ ::interp alias $child $command {} interp invokehidden $child $command
}
- # This alias lets the slave have access to a subset of the 'file'
+ # This alias lets the child have access to a subset of the 'file'
# command functionality.
foreach subcommand {dirname extension rootname tail} {
- ::interp alias $slave ::tcl::file::$subcommand {} \
- ::safe::AliasFileSubcommand $slave $subcommand
+ ::interp alias $child ::tcl::file::$subcommand {} \
+ ::safe::AliasFileSubcommand $child $subcommand
}
# Subcommand of 'encoding' that has special handling; [encoding system] is
# OK provided it has no other arguments passed to it.
- ::interp alias $slave ::tcl::encoding::system {} \
- ::safe::AliasEncodingSystem $slave
+ ::interp alias $child ::tcl::encoding::system {} \
+ ::safe::AliasEncodingSystem $child
# Subcommands of info
- ::interp alias $slave ::tcl::info::nameofexecutable {} \
- ::safe::AliasExeName $slave
+ ::interp alias $child ::tcl::info::nameofexecutable {} \
+ ::safe::AliasExeName $child
- # The allowed slave variables already have been set by Tcl_MakeSafe(3)
+ # The allowed child variables already have been set by Tcl_MakeSafe(3)
- # Source init.tcl and tm.tcl into the slave, to get auto_load and
+ # Source init.tcl and tm.tcl into the child, to get auto_load and
# other procedures defined:
- if {[catch {::interp eval $slave {
+ if {[catch {::interp eval $child {
source [file join $tcl_library init.tcl]
}} msg opt]} {
- Log $slave "can't source init.tcl ($msg)"
- return -options $opt "can't source init.tcl into slave $slave ($msg)"
+ Log $child "can't source init.tcl ($msg)"
+ return -options $opt "can't source init.tcl into child $child ($msg)"
}
- if {[catch {::interp eval $slave {
+ if {[catch {::interp eval $child {
source [file join $tcl_library tm.tcl]
}} msg opt]} {
- Log $slave "can't source tm.tcl ($msg)"
- return -options $opt "can't source tm.tcl into slave $slave ($msg)"
+ Log $child "can't source tm.tcl ($msg)"
+ return -options $opt "can't source tm.tcl into child $child ($msg)"
}
# Sync the paths used to search for Tcl modules. This can be done only
# now, after tm.tcl was loaded.
- namespace upvar ::safe S$slave state
- if {[llength $state(tm_path_slave)] > 0} {
- ::interp eval $slave [list \
- ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
+ namespace upvar ::safe [VarName $child] state
+ if {[llength $state(tm_path_child)] > 0} {
+ ::interp eval $child [list \
+ ::tcl::tm::add {*}[lreverse $state(tm_path_child)]]
}
- return $slave
+ return $child
}
# Add (only if needed, avoid duplicates) 1 level of sub directories to an
@@ -537,15 +576,30 @@ proc ::safe::AddSubDirs {pathList} {
return $res
}
-# This procedure deletes a safe slave managed by Safe Tcl and cleans up
-# associated state:
-
-proc ::safe::interpDelete {slave} {
- Log $slave "About to delete" NOTICE
-
- namespace upvar ::safe S$slave state
+# 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
+# amended at the next major revision by uncommenting "CheckInterp".
+
+proc ::safe::interpDelete {child} {
+ Log $child "About to delete" NOTICE
+
+ # CheckInterp $child
+ namespace upvar ::safe [VarName $child] state
+
+ # When an interpreter is deleted with [interp delete], any sub-interpreters
+ # are deleted automatically, but this leaves behind their data in the Safe
+ # Base. To clean up properly, we call safe::interpDelete recursively on each
+ # Safe Base sub-interpreter, so each one is deleted cleanly and not by
+ # the automatic mechanism built into [interp delete].
+ foreach sub [interp children $child] {
+ if {[info exists ::safe::[VarName [list $child $sub]]]} {
+ ::safe::interpDelete [list $child $sub]
+ }
+ }
- # If the slave has a cleanup hook registered, call it. Check the
+ # If the child has a cleanup hook registered, call it. Check the
# existance because we might be called to delete an interp which has
# not been registered with us at all
@@ -556,14 +610,14 @@ proc ::safe::interpDelete {slave} {
# we'll loop
unset state(cleanupHook)
try {
- {*}$hook $slave
+ {*}$hook $child
} on error err {
- Log $slave "Delete hook error ($err)"
+ Log $child "Delete hook error ($err)"
}
}
}
- # Discard the global array of state associated with the slave, and
+ # Discard the global array of state associated with the child, and
# delete the interpreter.
if {[info exists state]} {
@@ -572,9 +626,9 @@ proc ::safe::interpDelete {slave} {
# if we have been called twice, the interp might have been deleted
# already
- if {[::interp exists $slave]} {
- ::interp delete $slave
- Log $slave "Deleted" NOTICE
+ if {[::interp exists $child]} {
+ ::interp delete $child
+ Log $child "Deleted" NOTICE
}
return
@@ -600,9 +654,9 @@ proc ::safe::setLogCmd {args} {
} else {
# Activate logging, define proper command.
- proc ::safe::Log {slave msg {type ERROR}} {
+ proc ::safe::Log {child msg {type ERROR}} {
variable Log
- {*}$Log "$type for slave $slave : $msg"
+ {*}$Log "$type for child $child : $msg"
return
}
}
@@ -611,24 +665,24 @@ proc ::safe::setLogCmd {args} {
# ------------------- END OF PUBLIC METHODS ------------
#
-# Sets the slave auto_path to the master recorded value. Also sets
+# Sets the child auto_path to the parent recorded value. Also sets
# tcl_library to the first token of the virtual path.
#
-proc ::safe::SyncAccessPath {slave} {
- namespace upvar ::safe S$slave state
+proc ::safe::SyncAccessPath {child} {
+ namespace upvar ::safe [VarName $child] state
- set slave_access_path $state(access_path,slave)
- ::interp eval $slave [list set auto_path $slave_access_path]
+ set child_access_path $state(access_path,child)
+ ::interp eval $child [list set auto_path $child_access_path]
- Log $slave "auto_path in $slave has been set to $slave_access_path"\
+ Log $child "auto_path in $child has been set to $child_access_path"\
NOTICE
# This code assumes that info library is the first element in the
# list of auto_path's. See -> InterpSetConfig for the code which
# ensures this condition.
- ::interp eval $slave [list \
- set tcl_library [lindex $slave_access_path 0]]
+ ::interp eval $child [list \
+ set tcl_library [lindex $child_access_path 0]]
}
# Returns the virtual token for directory number N.
@@ -641,8 +695,8 @@ proc ::safe::PathToken {n} {
#
# translate virtual path into real path
#
-proc ::safe::TranslatePath {slave path} {
- namespace upvar ::safe S$slave state
+proc ::safe::TranslatePath {child path} {
+ namespace upvar ::safe [VarName $child] state
# somehow strip the namespaces 'functionality' out (the danger is that
# we would strip valid macintosh "../" queries... :
@@ -657,7 +711,7 @@ proc ::safe::TranslatePath {slave path} {
# file name control (limit access to files/resources that should be a
# valid tcl source file)
-proc ::safe::CheckFileName {slave file} {
+proc ::safe::CheckFileName {child file} {
# This used to limit what can be sourced to ".tcl" and forbid files
# with more than 1 dot and longer than 14 chars, but I changed that
# for 8.4 as a safe interp has enough internal protection already to
@@ -678,17 +732,17 @@ proc ::safe::CheckFileName {slave file} {
# interpreters that are *almost* safe. In particular, it just acts to
# prevent discovery of what home directories exist.
-proc ::safe::AliasFileSubcommand {slave subcommand name} {
+proc ::safe::AliasFileSubcommand {child subcommand name} {
if {[string match ~* $name]} {
set name ./$name
}
- tailcall ::interp invokehidden $slave tcl:file:$subcommand $name
+ tailcall ::interp invokehidden $child tcl:file:$subcommand $name
}
# AliasGlob is the target of the "glob" alias in safe interpreters.
-proc ::safe::AliasGlob {slave args} {
- Log $slave "GLOB ! $args" NOTICE
+proc ::safe::AliasGlob {child args} {
+ Log $child "GLOB ! $args" NOTICE
set cmd {}
set at 0
array set got {
@@ -710,11 +764,15 @@ proc ::safe::AliasGlob {slave args} {
while {$at < [llength $args]} {
switch -glob -- [set opt [lindex $args $at]] {
- -nocomplain - -- - -join - -tails {
+ -nocomplain - -- - -tails {
lappend cmd $opt
set got($opt) 1
incr at
}
+ -join {
+ set got($opt) 1
+ incr at
+ }
-types - -type {
lappend cmd -types [lindex $args [incr at]]
incr at
@@ -728,15 +786,8 @@ proc ::safe::AliasGlob {slave args} {
set virtualdir [lindex $args [incr at]]
incr at
}
- pkgIndex.tcl {
- # Oops, this is globbing a subdirectory in regular package
- # search. That is not wanted. Abort, handler does catch
- # already (because glob was not defined before). See
- # package.tcl, lines 484ff in tclPkgUnknown.
- return -code error "unknown command glob"
- }
-* {
- Log $slave "Safe base rejecting glob option '$opt'"
+ Log $child "Safe base rejecting glob option '$opt'"
return -code error "Safe base rejecting glob option '$opt'"
}
default {
@@ -747,73 +798,116 @@ proc ::safe::AliasGlob {slave args} {
}
# Get the real path from the virtual one and check that the path is in the
- # access path of that slave. Done after basic argument processing so that
+ # access path of that child. Done after basic argument processing so that
# we know if -nocomplain is set.
if {$got(-directory)} {
try {
- set dir [TranslatePath $slave $virtualdir]
- DirInAccessPath $slave $dir
+ set dir [TranslatePath $child $virtualdir]
+ DirInAccessPath $child $dir
} on error msg {
- Log $slave $msg
+ Log $child $msg
if {$got(-nocomplain)} return
return -code error "permission denied"
}
- lappend cmd -directory $dir
+ if {$got(--)} {
+ set cmd [linsert $cmd end-1 -directory $dir]
+ } else {
+ lappend cmd -directory $dir
+ }
+ } else {
+ # The code after this "if ... else" block would conspire to return with
+ # no results in this case, if it were allowed to proceed. Instead,
+ # return now and reduce the number of cases to be considered later.
+ Log $child {option -directory must be supplied}
+ if {$got(-nocomplain)} return
+ return -code error "permission denied"
}
- # Apply the -join semantics ourselves
+ # Apply the -join semantics ourselves.
if {$got(-join)} {
set args [lreplace $args $at end [join [lrange $args $at end] "/"]]
}
- # Process remaining pattern arguments
+ # Process the pattern arguments. If we've done a join there is only one
+ # pattern argument.
+
set firstPattern [llength $cmd]
foreach opt [lrange $args $at end] {
if {![regexp $dirPartRE $opt -> thedir thefile]} {
set thedir .
- } elseif {[string match ~* $thedir]} {
- set thedir ./$thedir
+ # The *.tm search comes here.
}
- if {$thedir eq "*" &&
- ($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} {
+ # "Special" treatment for (joined) argument {*/pkgIndex.tcl}.
+ # Do the expansion of "*" here, and filter out any directories that are
+ # not in the access path. The outcome is to lappend to cmd a path of
+ # the form $virtualdir/subdir/pkgIndex.tcl for each subdirectory subdir,
+ # after removing any subdir that are not in the access path.
+ if {($thedir eq "*") && ($thefile eq "pkgIndex.tcl")} {
set mapped 0
- foreach d [glob -directory [TranslatePath $slave $virtualdir] \
+ foreach d [glob -directory [TranslatePath $child $virtualdir] \
-types d -tails *] {
catch {
- DirInAccessPath $slave \
- [TranslatePath $slave [file join $virtualdir $d]]
+ DirInAccessPath $child \
+ [TranslatePath $child [file join $virtualdir $d]]
lappend cmd [file join $d $thefile]
set mapped 1
}
}
if {$mapped} continue
+ # Don't [continue] if */pkgIndex.tcl has no matches in the access
+ # path. The pattern will now receive the same treatment as a
+ # "non-special" pattern (and will fail because it includes a "*" in
+ # the directory name).
}
+ # Any directory pattern that is not an exact (i.e. non-glob) match to a
+ # directory in the access path will be rejected here.
+ # - Rejections include any directory pattern that has glob matching
+ # patterns "*", "?", backslashes, braces or square brackets, (UNLESS
+ # it corresponds to a genuine directory name AND that directory is in
+ # the access path).
+ # - The only "special matching characters" that remain in patterns for
+ # processing by glob are in the filename tail.
+ # - [file join $anything ~${foo}] is ~${foo}, which is not an exact
+ # match to any directory in the access path. Hence directory patterns
+ # that begin with "~" are rejected here. Tests safe-16.[5-8] check
+ # that "file join" remains as required and does not expand ~${foo}.
+ # - Bug [3529949] relates to unwanted expansion of ~${foo} and this is
+ # how the present code avoids the bug. All tests safe-16.* relate.
try {
- DirInAccessPath $slave [TranslatePath $slave \
+ DirInAccessPath $child [TranslatePath $child \
[file join $virtualdir $thedir]]
} on error msg {
- Log $slave $msg
+ Log $child $msg
if {$got(-nocomplain)} continue
return -code error "permission denied"
}
lappend cmd $opt
}
- Log $slave "GLOB = $cmd" NOTICE
+ Log $child "GLOB = $cmd" NOTICE
if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
return
}
try {
- set entries [::interp invokehidden $slave glob {*}$cmd]
+ # >>>>>>>>>> HERE'S THE CALL TO SAFE INTERP GLOB <<<<<<<<<<
+ # - Pattern arguments added to cmd have NOT been translated from tokens.
+ # Only the virtualdir is translated (to dir).
+ # - In the pkgIndex.tcl case, there is no "*" in the pattern arguments,
+ # which are a list of names each with tail pkgIndex.tcl. The purpose
+ # of the call to glob is to remove the names for which the file does
+ # not exist.
+ set entries [::interp invokehidden $child glob {*}$cmd]
} on error msg {
- Log $slave $msg
+ # This is the only place that a call with -nocomplain and no invalid
+ # "dash-options" can return an error.
+ Log $child $msg
return -code error "script error"
}
- Log $slave "GLOB < $entries" NOTICE
+ Log $child "GLOB < $entries" NOTICE
- # Translate path back to what the slave should see.
+ # Translate path back to what the child should see.
set res {}
set l [string length $dir]
foreach p $entries {
@@ -823,13 +917,13 @@ proc ::safe::AliasGlob {slave args} {
lappend res $p
}
- Log $slave "GLOB > $res" NOTICE
+ Log $child "GLOB > $res" NOTICE
return $res
}
# AliasSource is the target of the "source" alias in safe interpreters.
-proc ::safe::AliasSource {slave args} {
+proc ::safe::AliasSource {child args} {
set argc [llength $args]
# Extended for handling of Tcl Modules to allow not only "source
# filename", but "source -encoding E filename" as well.
@@ -838,7 +932,7 @@ proc ::safe::AliasSource {slave args} {
set encoding [lindex $args 1]
set at 2
if {$encoding eq "identity"} {
- Log $slave "attempt to use the identity encoding"
+ Log $child "attempt to use the identity encoding"
return -code error "permission denied"
}
} else {
@@ -847,39 +941,42 @@ proc ::safe::AliasSource {slave args} {
}
if {$argc != 1} {
set msg "wrong # args: should be \"source ?-encoding E? fileName\""
- Log $slave "$msg ($args)"
+ Log $child "$msg ($args)"
return -code error $msg
}
set file [lindex $args $at]
# get the real path from the virtual one.
if {[catch {
- set realfile [TranslatePath $slave $file]
+ set realfile [TranslatePath $child $file]
} msg]} {
- Log $slave $msg
+ Log $child $msg
return -code error "permission denied"
}
- # check that the path is in the access path of that slave
+ # check that the path is in the access path of that child
if {[catch {
- FileInAccessPath $slave $realfile
+ FileInAccessPath $child $realfile
} msg]} {
- Log $slave $msg
+ Log $child $msg
return -code error "permission denied"
}
- # do the checks on the filename :
+ # Check that the filename exists and is readable. If it is not, deliver
+ # this -errorcode so that caller in tclPkgUnknown does not write a message
+ # to tclLog. Has no effect on other callers of ::source, which are in
+ # "package ifneeded" scripts.
if {[catch {
- CheckFileName $slave $realfile
+ CheckFileName $child $realfile
} msg]} {
- Log $slave "$realfile:$msg"
- return -code error $msg
+ Log $child "$realfile:$msg"
+ return -code error -errorcode {POSIX EACCES} $msg
}
# Passed all the tests, lets source it. Note that we do this all manually
- # because we want to control [info script] in the slave so information
+ # because we want to control [info script] in the child so information
# doesn't leak so much. [Bug 2913625]
- set old [::interp eval $slave {info script}]
+ set old [::interp eval $child {info script}]
set replacementMsg "script error"
set code [catch {
set f [open $realfile]
@@ -889,17 +986,17 @@ proc ::safe::AliasSource {slave args} {
}
set contents [read $f]
close $f
- ::interp eval $slave [list info script $file]
+ ::interp eval $child [list info script $file]
} msg opt]
if {$code == 0} {
- set code [catch {::interp eval $slave $contents} msg opt]
+ set code [catch {::interp eval $child $contents} msg opt]
set replacementMsg $msg
}
- catch {interp eval $slave [list info script $old]}
+ catch {interp eval $child [list info script $old]}
# Note that all non-errors are fine result codes from [source], so we must
# take a little care to do it properly. [Bug 2923613]
if {$code == 1} {
- Log $slave $msg
+ Log $child $msg
return -code error $replacementMsg
}
return -code $code -options $opt $msg
@@ -907,18 +1004,18 @@ proc ::safe::AliasSource {slave args} {
# AliasLoad is the target of the "load" alias in safe interpreters.
-proc ::safe::AliasLoad {slave file args} {
+proc ::safe::AliasLoad {child file args} {
set argc [llength $args]
if {$argc > 2} {
set msg "load error: too many arguments"
- Log $slave "$msg ($argc) {$file $args}"
+ Log $child "$msg ($argc) {$file $args}"
return -code error $msg
}
# package name (can be empty if file is not).
set package [lindex $args 0]
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $child] state
# Determine where to load. load use a relative interp path and {}
# means self, so we can directly and safely use passed arg.
@@ -927,7 +1024,7 @@ proc ::safe::AliasLoad {slave file args} {
# we will try to load into a sub sub interp; check that we want to
# authorize that.
if {!$state(nestedok)} {
- Log $slave "loading to a sub interp (nestedok)\
+ Log $child "loading to a sub interp (nestedok)\
disabled (trying to load $package to $target)"
return -code error "permission denied (nested load)"
}
@@ -938,11 +1035,11 @@ proc ::safe::AliasLoad {slave file args} {
# static package loading
if {$package eq ""} {
set msg "load error: empty filename and no package name"
- Log $slave $msg
+ Log $child $msg
return -code error $msg
}
if {!$state(staticsok)} {
- Log $slave "static packages loading disabled\
+ Log $child "static packages loading disabled\
(trying to load $package to $target)"
return -code error "permission denied (static package)"
}
@@ -951,36 +1048,43 @@ proc ::safe::AliasLoad {slave file args} {
# get the real path from the virtual one.
try {
- set file [TranslatePath $slave $file]
+ set file [TranslatePath $child $file]
} on error msg {
- Log $slave $msg
+ Log $child $msg
return -code error "permission denied"
}
# check the translated path
try {
- FileInAccessPath $slave $file
+ FileInAccessPath $child $file
} on error msg {
- Log $slave $msg
+ Log $child $msg
return -code error "permission denied (path)"
}
}
try {
- return [::interp invokehidden $slave load $file $package $target]
+ return [::interp invokehidden $child load $file $package $target]
} on error msg {
- Log $slave $msg
+ # Some packages return no error message.
+ set msg0 "load of binary library for package $package failed"
+ if {$msg eq {}} {
+ set msg $msg0
+ } else {
+ set msg "$msg0: $msg"
+ }
+ Log $child $msg
return -code error $msg
}
}
# FileInAccessPath raises an error if the file is not found in the list of
-# directories contained in the (master side recorded) slave's access path.
+# directories contained in the (parent side recorded) child's access path.
# the security here relies on "file dirname" answering the proper
# result... needs checking ?
-proc ::safe::FileInAccessPath {slave file} {
- namespace upvar ::safe S$slave state
+proc ::safe::FileInAccessPath {child file} {
+ namespace upvar ::safe [VarName $child] state
set access_path $state(access_path)
if {[file isdirectory $file]} {
@@ -992,14 +1096,14 @@ proc ::safe::FileInAccessPath {slave file} {
# potential pathname anomalies.
set norm_parent [file normalize $parent]
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $child] state
if {$norm_parent ni $state(access_path,norm)} {
return -code error "\"$file\": not in access_path"
}
}
-proc ::safe::DirInAccessPath {slave dir} {
- namespace upvar ::safe S$slave state
+proc ::safe::DirInAccessPath {child dir} {
+ namespace upvar ::safe [VarName $child] state
set access_path $state(access_path)
if {[file isfile $dir]} {
@@ -1010,7 +1114,7 @@ proc ::safe::DirInAccessPath {slave dir} {
# potential pathname anomalies.
set norm_dir [file normalize $dir]
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $child] state
if {$norm_dir ni $state(access_path,norm)} {
return -code error "\"$dir\": not in access_path"
}
@@ -1019,35 +1123,87 @@ proc ::safe::DirInAccessPath {slave dir} {
# This procedure is used to report an attempt to use an unsafe member of an
# ensemble command.
-proc ::safe::BadSubcommand {slave command subcommand args} {
+proc ::safe::BadSubcommand {child command subcommand args} {
set msg "not allowed to invoke subcommand $subcommand of $command"
- Log $slave $msg
+ Log $child $msg
return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}
# AliasEncodingSystem is the target of the "encoding system" alias in safe
# interpreters.
-proc ::safe::AliasEncodingSystem {slave args} {
+proc ::safe::AliasEncodingSystem {child args} {
try {
- # Must not pass extra arguments; safe slaves 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\""
}
} on error {msg options} {
- Log $slave $msg
+ Log $child $msg
return -options $options $msg
}
- tailcall ::interp invokehidden $slave tcl:encoding:system
+ tailcall ::interp invokehidden $child tcl:encoding:system
}
# Various minor hiding of platform features. [Bug 2913625]
-proc ::safe::AliasExeName {slave} {
+proc ::safe::AliasExeName {child} {
return ""
}
+# ------------------------------------------------------------------------------
+# Using Interpreter Names with Namespace Qualifiers
+# ------------------------------------------------------------------------------
+# (1) We wish to preserve compatibility with existing code, in which Safe Base
+# interpreter names have no namespace qualifiers.
+# (2) safe::interpCreate and the rest of the Safe Base previously could not
+# accept namespace qualifiers in an interpreter name.
+# (3) The interp command will accept namespace qualifiers in an interpreter
+# name, but accepts distinct interpreters that will have the same command
+# name (e.g. foo, ::foo, and :::foo) (bug 66c2e8c974).
+# (4) To satisfy these constraints, Safe Base interpreter names will be fully
+# qualified namespace names with no excess colons and with the leading "::"
+# omitted.
+# (5) Trailing "::" implies a namespace tail {}, which interp reads as {{}}.
+# Reject such names.
+# (6) We could:
+# (a) EITHER reject usable but non-compliant names (e.g. excess colons) in
+# interpCreate, interpInit;
+# (b) OR accept such names and then translate to a compliant name in every
+# command.
+# The problem with (b) is that the user will expect to use the name with the
+# interp command and will find that it is not recognised.
+# E.g "interpCreate ::foo" creates interpreter "foo", and the user's name
+# "::foo" works with all the Safe Base commands, but "interp eval ::foo"
+# fails.
+# So we choose (a).
+# (7) The command
+# namespace upvar ::safe S$child state
+# becomes
+# namespace upvar ::safe [VarName $child] state
+# ------------------------------------------------------------------------------
+
+proc ::safe::RejectExcessColons {child} {
+ set stripped [regsub -all -- {:::*} $child ::]
+ if {[string range $stripped end-1 end] eq {::}} {
+ return -code error {interpreter name must not end in "::"}
+ }
+ if {$stripped ne $child} {
+ set msg {interpreter name has excess colons in namespace separators}
+ return -code error $msg
+ }
+ if {[string range $stripped 0 1] eq {::}} {
+ return -code error {interpreter name must not begin "::"}
+ }
+ return
+}
+
+proc ::safe::VarName {child} {
+ # return S$child
+ return S[string map {:: @N @ @A} $child]
+}
+
proc ::safe::Setup {} {
####
#
@@ -1057,7 +1213,7 @@ proc ::safe::Setup {} {
# Share the descriptions
set temp [::tcl::OptKeyRegister {
- {-accessPath -list {} "access path for the slave"}
+ {-accessPath -list {} "access path for the child"}
{-noStatics "prevent loading of statically linked pkgs"}
{-statics true "loading of statically linked pkgs"}
{-nestedLoadOk "allow nested loading"}
@@ -1065,18 +1221,18 @@ proc ::safe::Setup {} {
{-deleteHook -script {} "delete hook"}
}]
- # create case (slave is optional)
+ # create case (child is optional)
::tcl::OptKeyRegister {
- {?slave? -name {} "name of the slave (optional)"}
+ {?child? -name {} "name of the child (optional)"}
} ::safe::interpCreate
# adding the flags sub programs to the command program (relying on Opt's
# internal implementation details)
lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)
- # init and configure (slave is needed)
+ # init and configure (child is needed)
::tcl::OptKeyRegister {
- {slave -name {} "name of the slave"}
+ {child -name {} "name of the child"}
} ::safe::interpIC
# adding the flags sub programs to the command program (relying on Opt's
@@ -1106,20 +1262,20 @@ namespace eval ::safe {
# Log command, set via 'setLogCmd'. Logging is disabled when empty.
variable Log {}
- # The package maintains a state array per slave interp under its
+ # The package maintains a state array per child interp under its
# control. The name of this array is S<interp-name>. This array is
# brought into scope where needed, using 'namespace upvar'. The S
- # prefix is used to avoid that a slave interp called "Log" smashes
+ # prefix is used to avoid that a child interp called "Log" smashes
# the "Log" variable.
#
# The array's elements are:
#
- # access_path : List of paths accessible to the slave.
+ # access_path : List of paths accessible to the child.
# access_path,norm : Ditto, in normalized form.
- # access_path,slave : Ditto, as the path tokens as seen by the slave.
+ # access_path,child : Ditto, as the path tokens as seen by the child.
# access_path,map : dict ( token -> path )
# access_path,remap : dict ( path -> token )
- # tm_path_slave : List of TM root directories, as tokens seen by the slave.
+ # tm_path_child : List of TM root directories, as tokens seen by the child.
# staticsok : Value of option -statics
# nestedok : Value of option -nested
# cleanupHook : Value of option -deleteHook
diff --git a/library/tclIndex b/library/tclIndex
index 87a2814..5f7fbfb 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -15,7 +15,7 @@ set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join
set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::slavehook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::childhook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index e4edfda..2af79bc 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -640,7 +640,7 @@ namespace eval tcltest {
proc IsVerbose {level} {
variable Option
- return [expr {[lsearch -exact $Option(-verbose) $level] != -1}]
+ return [expr {[lsearch -exact $Option(-verbose) $level] >= 0}]
}
# Default verbosity is to show bodies of failed tests
@@ -811,14 +811,14 @@ namespace eval tcltest {
trace add variable Option(-errfile) write \
[namespace code {errorChannel $Option(-errfile) ;#}]
- proc loadIntoSlaveInterpreter {slave args} {
+ proc loadIntoChildInterpreter {child args} {
variable Version
- interp eval $slave [package ifneeded tcltest $Version]
- interp eval $slave "tcltest::configure {*}{$args}"
- interp alias $slave ::tcltest::ReportToMaster \
- {} ::tcltest::ReportedFromSlave
+ interp eval $child [package ifneeded tcltest $Version]
+ interp eval $child "tcltest::configure {*}{$args}"
+ interp alias $child ::tcltest::ReportToParent \
+ {} ::tcltest::ReportedFromChild
}
- proc ReportedFromSlave {total passed skipped failed because newfiles} {
+ proc ReportedFromChild {total passed skipped failed because newfiles} {
variable numTests
variable skippedBecause
variable createdNewFiles
@@ -2462,8 +2462,8 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
set testFileName [file tail [info script]]
# Hook to handle reporting to a parent interpreter
- if {[llength [info commands [namespace current]::ReportToMaster]]} {
- ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
+ if {[llength [info commands [namespace current]::ReportToParent]]} {
+ ReportToParent $numTests(Total) $numTests(Passed) $numTests(Skipped) \
$numTests(Failed) [array get skippedBecause] \
[array get createdNewFiles]
set testSingleFile false
@@ -3107,7 +3107,7 @@ proc tcltest::removeFile {name {directory ""}} {
set fullName [file join $directory $name]
DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName"
set idx [lsearch -exact $filesMade $fullName]
- if {$idx == -1} {
+ if {$idx < 0} {
DebugDo 1 {
Warn "removeFile removing \"$fullName\":\n not created by makeFile"
}
@@ -3184,7 +3184,7 @@ proc tcltest::removeDirectory {name {directory ""}} {
DebugPuts 3 "[lindex [info level 0] 0]: deleting $fullName"
set idx [lsearch -exact $filesMade $fullName]
set filesMade [lreplace $filesMade $idx $idx]
- if {$idx == -1} {
+ if {$idx < 0} {
DebugDo 1 {
Warn "removeDirectory removing \"$fullName\":\n not created\
by makeDirectory"
diff --git a/library/tm.tcl b/library/tm.tcl
index 1802bb9..c60084c 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -212,11 +212,12 @@ proc ::tcl::tm::UnknownHandler {original name args} {
}
set strip [llength [file split $path]]
- # We can't use glob in safe interps, so enclose the following in a
- # catch statement, where we get the module files out of the
- # subdirectories. In other words, Tcl Modules are not-functional
- # in such an interpreter. This is the same as for the command
- # "tclPkgUnknown", i.e. the search for regular packages.
+ # Get the module files out of the subdirectories.
+ # - Safe Base interpreters have a restricted "glob" command that
+ # works in this case.
+ # - The "catch" was essential when there was no safe glob and every
+ # call in a safe interp failed; it is retained only for corner
+ # cases in which the eventual call to glob returns an error.
catch {
# We always look for _all_ possible modules in the current
@@ -238,12 +239,16 @@ proc ::tcl::tm::UnknownHandler {original name args} {
continue
}
- if {[package ifneeded $pkgname $pkgversion] ne {}} {
+ if {([package ifneeded $pkgname $pkgversion] ne {})
+ && (![interp issafe])
+ } {
# There's already a provide script registered for
# this version of this package. Since all units of
# code claiming to be the same version of the same
# package ought to be identical, just stick with
# the one we already have.
+ # This does not apply to Safe Base interpreters because
+ # the token-to-directory mapping may have changed.
continue
}
diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca
index 99027c9..05ae49f 100644
--- a/library/tzdata/Africa/Casablanca
+++ b/library/tzdata/Africa/Casablanca
@@ -60,7 +60,7 @@ set TZData(:Africa/Casablanca) {
{1557021600 0 1 +01}
{1560045600 3600 0 +01}
{1587261600 0 1 +01}
- {1590285600 3600 0 +01}
+ {1590890400 3600 0 +01}
{1618106400 0 1 +01}
{1621130400 3600 0 +01}
{1648346400 0 1 +01}
@@ -76,7 +76,7 @@ set TZData(:Africa/Casablanca) {
{1801965600 0 1 +01}
{1804989600 3600 0 +01}
{1832205600 0 1 +01}
- {1835229600 3600 0 +01}
+ {1835834400 3600 0 +01}
{1863050400 0 1 +01}
{1866074400 3600 0 +01}
{1893290400 0 1 +01}
@@ -92,7 +92,7 @@ set TZData(:Africa/Casablanca) {
{2046304800 0 1 +01}
{2049933600 3600 0 +01}
{2077149600 0 1 +01}
- {2080173600 3600 0 +01}
+ {2080778400 3600 0 +01}
{2107994400 0 1 +01}
{2111018400 3600 0 +01}
{2138234400 0 1 +01}
@@ -108,7 +108,7 @@ set TZData(:Africa/Casablanca) {
{2291248800 0 1 +01}
{2294877600 3600 0 +01}
{2322093600 0 1 +01}
- {2325117600 3600 0 +01}
+ {2325722400 3600 0 +01}
{2352938400 0 1 +01}
{2355962400 3600 0 +01}
{2383178400 0 1 +01}
@@ -124,7 +124,7 @@ set TZData(:Africa/Casablanca) {
{2536192800 0 1 +01}
{2539821600 3600 0 +01}
{2567037600 0 1 +01}
- {2570061600 3600 0 +01}
+ {2570666400 3600 0 +01}
{2597882400 0 1 +01}
{2600906400 3600 0 +01}
{2628122400 0 1 +01}
@@ -140,7 +140,7 @@ set TZData(:Africa/Casablanca) {
{2781136800 0 1 +01}
{2784765600 3600 0 +01}
{2811981600 0 1 +01}
- {2815005600 3600 0 +01}
+ {2815610400 3600 0 +01}
{2842826400 0 1 +01}
{2845850400 3600 0 +01}
{2873066400 0 1 +01}
@@ -150,13 +150,13 @@ set TZData(:Africa/Casablanca) {
{2934756000 0 1 +01}
{2937780000 3600 0 +01}
{2964996000 0 1 +01}
- {2968020000 3600 0 +01}
+ {2968624800 3600 0 +01}
{2995840800 0 1 +01}
{2998864800 3600 0 +01}
{3026080800 0 1 +01}
{3029709600 3600 0 +01}
{3056925600 0 1 +01}
- {3059949600 3600 0 +01}
+ {3060554400 3600 0 +01}
{3087770400 0 1 +01}
{3090794400 3600 0 +01}
{3118010400 0 1 +01}
@@ -166,13 +166,13 @@ set TZData(:Africa/Casablanca) {
{3179700000 0 1 +01}
{3182724000 3600 0 +01}
{3209940000 0 1 +01}
- {3212964000 3600 0 +01}
+ {3213568800 3600 0 +01}
{3240784800 0 1 +01}
{3243808800 3600 0 +01}
{3271024800 0 1 +01}
{3274653600 3600 0 +01}
{3301869600 0 1 +01}
- {3304893600 3600 0 +01}
+ {3305498400 3600 0 +01}
{3332714400 0 1 +01}
{3335738400 3600 0 +01}
{3362954400 0 1 +01}
@@ -182,7 +182,7 @@ set TZData(:Africa/Casablanca) {
{3424644000 0 1 +01}
{3427668000 3600 0 +01}
{3454884000 0 1 +01}
- {3457908000 3600 0 +01}
+ {3458512800 3600 0 +01}
{3485728800 0 1 +01}
{3488752800 3600 0 +01}
{3515968800 0 1 +01}
@@ -198,5 +198,5 @@ set TZData(:Africa/Casablanca) {
{3669588000 0 1 +01}
{3672612000 3600 0 +01}
{3699828000 0 1 +01}
- {3702852000 3600 0 +01}
+ {3703456800 3600 0 +01}
}
diff --git a/library/tzdata/Africa/El_Aaiun b/library/tzdata/Africa/El_Aaiun
index 9f021a4..8dbbdea 100644
--- a/library/tzdata/Africa/El_Aaiun
+++ b/library/tzdata/Africa/El_Aaiun
@@ -49,7 +49,7 @@ set TZData(:Africa/El_Aaiun) {
{1557021600 0 1 +01}
{1560045600 3600 0 +01}
{1587261600 0 1 +01}
- {1590285600 3600 0 +01}
+ {1590890400 3600 0 +01}
{1618106400 0 1 +01}
{1621130400 3600 0 +01}
{1648346400 0 1 +01}
@@ -65,7 +65,7 @@ set TZData(:Africa/El_Aaiun) {
{1801965600 0 1 +01}
{1804989600 3600 0 +01}
{1832205600 0 1 +01}
- {1835229600 3600 0 +01}
+ {1835834400 3600 0 +01}
{1863050400 0 1 +01}
{1866074400 3600 0 +01}
{1893290400 0 1 +01}
@@ -81,7 +81,7 @@ set TZData(:Africa/El_Aaiun) {
{2046304800 0 1 +01}
{2049933600 3600 0 +01}
{2077149600 0 1 +01}
- {2080173600 3600 0 +01}
+ {2080778400 3600 0 +01}
{2107994400 0 1 +01}
{2111018400 3600 0 +01}
{2138234400 0 1 +01}
@@ -97,7 +97,7 @@ set TZData(:Africa/El_Aaiun) {
{2291248800 0 1 +01}
{2294877600 3600 0 +01}
{2322093600 0 1 +01}
- {2325117600 3600 0 +01}
+ {2325722400 3600 0 +01}
{2352938400 0 1 +01}
{2355962400 3600 0 +01}
{2383178400 0 1 +01}
@@ -113,7 +113,7 @@ set TZData(:Africa/El_Aaiun) {
{2536192800 0 1 +01}
{2539821600 3600 0 +01}
{2567037600 0 1 +01}
- {2570061600 3600 0 +01}
+ {2570666400 3600 0 +01}
{2597882400 0 1 +01}
{2600906400 3600 0 +01}
{2628122400 0 1 +01}
@@ -129,7 +129,7 @@ set TZData(:Africa/El_Aaiun) {
{2781136800 0 1 +01}
{2784765600 3600 0 +01}
{2811981600 0 1 +01}
- {2815005600 3600 0 +01}
+ {2815610400 3600 0 +01}
{2842826400 0 1 +01}
{2845850400 3600 0 +01}
{2873066400 0 1 +01}
@@ -139,13 +139,13 @@ set TZData(:Africa/El_Aaiun) {
{2934756000 0 1 +01}
{2937780000 3600 0 +01}
{2964996000 0 1 +01}
- {2968020000 3600 0 +01}
+ {2968624800 3600 0 +01}
{2995840800 0 1 +01}
{2998864800 3600 0 +01}
{3026080800 0 1 +01}
{3029709600 3600 0 +01}
{3056925600 0 1 +01}
- {3059949600 3600 0 +01}
+ {3060554400 3600 0 +01}
{3087770400 0 1 +01}
{3090794400 3600 0 +01}
{3118010400 0 1 +01}
@@ -155,13 +155,13 @@ set TZData(:Africa/El_Aaiun) {
{3179700000 0 1 +01}
{3182724000 3600 0 +01}
{3209940000 0 1 +01}
- {3212964000 3600 0 +01}
+ {3213568800 3600 0 +01}
{3240784800 0 1 +01}
{3243808800 3600 0 +01}
{3271024800 0 1 +01}
{3274653600 3600 0 +01}
{3301869600 0 1 +01}
- {3304893600 3600 0 +01}
+ {3305498400 3600 0 +01}
{3332714400 0 1 +01}
{3335738400 3600 0 +01}
{3362954400 0 1 +01}
@@ -171,7 +171,7 @@ set TZData(:Africa/El_Aaiun) {
{3424644000 0 1 +01}
{3427668000 3600 0 +01}
{3454884000 0 1 +01}
- {3457908000 3600 0 +01}
+ {3458512800 3600 0 +01}
{3485728800 0 1 +01}
{3488752800 3600 0 +01}
{3515968800 0 1 +01}
@@ -187,5 +187,5 @@ set TZData(:Africa/El_Aaiun) {
{3669588000 0 1 +01}
{3672612000 3600 0 +01}
{3699828000 0 1 +01}
- {3702852000 3600 0 +01}
+ {3703456800 3600 0 +01}
}
diff --git a/library/tzdata/America/Dawson b/library/tzdata/America/Dawson
index 8d2b641..1c827ff 100644
--- a/library/tzdata/America/Dawson
+++ b/library/tzdata/America/Dawson
@@ -93,164 +93,5 @@ set TZData(:America/Dawson) {
{1541322000 -28800 0 PST}
{1552212000 -25200 1 PDT}
{1572771600 -28800 0 PST}
- {1583661600 -25200 1 PDT}
- {1604221200 -28800 0 PST}
- {1615716000 -25200 1 PDT}
- {1636275600 -28800 0 PST}
- {1647165600 -25200 1 PDT}
- {1667725200 -28800 0 PST}
- {1678615200 -25200 1 PDT}
- {1699174800 -28800 0 PST}
- {1710064800 -25200 1 PDT}
- {1730624400 -28800 0 PST}
- {1741514400 -25200 1 PDT}
- {1762074000 -28800 0 PST}
- {1772964000 -25200 1 PDT}
- {1793523600 -28800 0 PST}
- {1805018400 -25200 1 PDT}
- {1825578000 -28800 0 PST}
- {1836468000 -25200 1 PDT}
- {1857027600 -28800 0 PST}
- {1867917600 -25200 1 PDT}
- {1888477200 -28800 0 PST}
- {1899367200 -25200 1 PDT}
- {1919926800 -28800 0 PST}
- {1930816800 -25200 1 PDT}
- {1951376400 -28800 0 PST}
- {1962871200 -25200 1 PDT}
- {1983430800 -28800 0 PST}
- {1994320800 -25200 1 PDT}
- {2014880400 -28800 0 PST}
- {2025770400 -25200 1 PDT}
- {2046330000 -28800 0 PST}
- {2057220000 -25200 1 PDT}
- {2077779600 -28800 0 PST}
- {2088669600 -25200 1 PDT}
- {2109229200 -28800 0 PST}
- {2120119200 -25200 1 PDT}
- {2140678800 -28800 0 PST}
- {2152173600 -25200 1 PDT}
- {2172733200 -28800 0 PST}
- {2183623200 -25200 1 PDT}
- {2204182800 -28800 0 PST}
- {2215072800 -25200 1 PDT}
- {2235632400 -28800 0 PST}
- {2246522400 -25200 1 PDT}
- {2267082000 -28800 0 PST}
- {2277972000 -25200 1 PDT}
- {2298531600 -28800 0 PST}
- {2309421600 -25200 1 PDT}
- {2329981200 -28800 0 PST}
- {2341476000 -25200 1 PDT}
- {2362035600 -28800 0 PST}
- {2372925600 -25200 1 PDT}
- {2393485200 -28800 0 PST}
- {2404375200 -25200 1 PDT}
- {2424934800 -28800 0 PST}
- {2435824800 -25200 1 PDT}
- {2456384400 -28800 0 PST}
- {2467274400 -25200 1 PDT}
- {2487834000 -28800 0 PST}
- {2499328800 -25200 1 PDT}
- {2519888400 -28800 0 PST}
- {2530778400 -25200 1 PDT}
- {2551338000 -28800 0 PST}
- {2562228000 -25200 1 PDT}
- {2582787600 -28800 0 PST}
- {2593677600 -25200 1 PDT}
- {2614237200 -28800 0 PST}
- {2625127200 -25200 1 PDT}
- {2645686800 -28800 0 PST}
- {2656576800 -25200 1 PDT}
- {2677136400 -28800 0 PST}
- {2688631200 -25200 1 PDT}
- {2709190800 -28800 0 PST}
- {2720080800 -25200 1 PDT}
- {2740640400 -28800 0 PST}
- {2751530400 -25200 1 PDT}
- {2772090000 -28800 0 PST}
- {2782980000 -25200 1 PDT}
- {2803539600 -28800 0 PST}
- {2814429600 -25200 1 PDT}
- {2834989200 -28800 0 PST}
- {2846484000 -25200 1 PDT}
- {2867043600 -28800 0 PST}
- {2877933600 -25200 1 PDT}
- {2898493200 -28800 0 PST}
- {2909383200 -25200 1 PDT}
- {2929942800 -28800 0 PST}
- {2940832800 -25200 1 PDT}
- {2961392400 -28800 0 PST}
- {2972282400 -25200 1 PDT}
- {2992842000 -28800 0 PST}
- {3003732000 -25200 1 PDT}
- {3024291600 -28800 0 PST}
- {3035786400 -25200 1 PDT}
- {3056346000 -28800 0 PST}
- {3067236000 -25200 1 PDT}
- {3087795600 -28800 0 PST}
- {3098685600 -25200 1 PDT}
- {3119245200 -28800 0 PST}
- {3130135200 -25200 1 PDT}
- {3150694800 -28800 0 PST}
- {3161584800 -25200 1 PDT}
- {3182144400 -28800 0 PST}
- {3193034400 -25200 1 PDT}
- {3213594000 -28800 0 PST}
- {3225088800 -25200 1 PDT}
- {3245648400 -28800 0 PST}
- {3256538400 -25200 1 PDT}
- {3277098000 -28800 0 PST}
- {3287988000 -25200 1 PDT}
- {3308547600 -28800 0 PST}
- {3319437600 -25200 1 PDT}
- {3339997200 -28800 0 PST}
- {3350887200 -25200 1 PDT}
- {3371446800 -28800 0 PST}
- {3382941600 -25200 1 PDT}
- {3403501200 -28800 0 PST}
- {3414391200 -25200 1 PDT}
- {3434950800 -28800 0 PST}
- {3445840800 -25200 1 PDT}
- {3466400400 -28800 0 PST}
- {3477290400 -25200 1 PDT}
- {3497850000 -28800 0 PST}
- {3508740000 -25200 1 PDT}
- {3529299600 -28800 0 PST}
- {3540189600 -25200 1 PDT}
- {3560749200 -28800 0 PST}
- {3572244000 -25200 1 PDT}
- {3592803600 -28800 0 PST}
- {3603693600 -25200 1 PDT}
- {3624253200 -28800 0 PST}
- {3635143200 -25200 1 PDT}
- {3655702800 -28800 0 PST}
- {3666592800 -25200 1 PDT}
- {3687152400 -28800 0 PST}
- {3698042400 -25200 1 PDT}
- {3718602000 -28800 0 PST}
- {3730096800 -25200 1 PDT}
- {3750656400 -28800 0 PST}
- {3761546400 -25200 1 PDT}
- {3782106000 -28800 0 PST}
- {3792996000 -25200 1 PDT}
- {3813555600 -28800 0 PST}
- {3824445600 -25200 1 PDT}
- {3845005200 -28800 0 PST}
- {3855895200 -25200 1 PDT}
- {3876454800 -28800 0 PST}
- {3887344800 -25200 1 PDT}
- {3907904400 -28800 0 PST}
- {3919399200 -25200 1 PDT}
- {3939958800 -28800 0 PST}
- {3950848800 -25200 1 PDT}
- {3971408400 -28800 0 PST}
- {3982298400 -25200 1 PDT}
- {4002858000 -28800 0 PST}
- {4013748000 -25200 1 PDT}
- {4034307600 -28800 0 PST}
- {4045197600 -25200 1 PDT}
- {4065757200 -28800 0 PST}
- {4076647200 -25200 1 PDT}
- {4097206800 -28800 0 PST}
+ {1583661600 -25200 0 MST}
}
diff --git a/library/tzdata/America/Godthab b/library/tzdata/America/Godthab
index 3e45f87..8bb7b73 100644
--- a/library/tzdata/America/Godthab
+++ b/library/tzdata/America/Godthab
@@ -1,246 +1,5 @@
# created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Godthab) {
- {-9223372036854775808 -12416 0 LMT}
- {-1686083584 -10800 0 -03}
- {323845200 -7200 0 -02}
- {338950800 -10800 0 -03}
- {354675600 -7200 1 -02}
- {370400400 -10800 0 -03}
- {386125200 -7200 1 -02}
- {401850000 -10800 0 -03}
- {417574800 -7200 1 -02}
- {433299600 -10800 0 -03}
- {449024400 -7200 1 -02}
- {465354000 -10800 0 -03}
- {481078800 -7200 1 -02}
- {496803600 -10800 0 -03}
- {512528400 -7200 1 -02}
- {528253200 -10800 0 -03}
- {543978000 -7200 1 -02}
- {559702800 -10800 0 -03}
- {575427600 -7200 1 -02}
- {591152400 -10800 0 -03}
- {606877200 -7200 1 -02}
- {622602000 -10800 0 -03}
- {638326800 -7200 1 -02}
- {654656400 -10800 0 -03}
- {670381200 -7200 1 -02}
- {686106000 -10800 0 -03}
- {701830800 -7200 1 -02}
- {717555600 -10800 0 -03}
- {733280400 -7200 1 -02}
- {749005200 -10800 0 -03}
- {764730000 -7200 1 -02}
- {780454800 -10800 0 -03}
- {796179600 -7200 1 -02}
- {811904400 -10800 0 -03}
- {828234000 -7200 1 -02}
- {846378000 -10800 0 -03}
- {859683600 -7200 1 -02}
- {877827600 -10800 0 -03}
- {891133200 -7200 1 -02}
- {909277200 -10800 0 -03}
- {922582800 -7200 1 -02}
- {941331600 -10800 0 -03}
- {954032400 -7200 1 -02}
- {972781200 -10800 0 -03}
- {985482000 -7200 1 -02}
- {1004230800 -10800 0 -03}
- {1017536400 -7200 1 -02}
- {1035680400 -10800 0 -03}
- {1048986000 -7200 1 -02}
- {1067130000 -10800 0 -03}
- {1080435600 -7200 1 -02}
- {1099184400 -10800 0 -03}
- {1111885200 -7200 1 -02}
- {1130634000 -10800 0 -03}
- {1143334800 -7200 1 -02}
- {1162083600 -10800 0 -03}
- {1174784400 -7200 1 -02}
- {1193533200 -10800 0 -03}
- {1206838800 -7200 1 -02}
- {1224982800 -10800 0 -03}
- {1238288400 -7200 1 -02}
- {1256432400 -10800 0 -03}
- {1269738000 -7200 1 -02}
- {1288486800 -10800 0 -03}
- {1301187600 -7200 1 -02}
- {1319936400 -10800 0 -03}
- {1332637200 -7200 1 -02}
- {1351386000 -10800 0 -03}
- {1364691600 -7200 1 -02}
- {1382835600 -10800 0 -03}
- {1396141200 -7200 1 -02}
- {1414285200 -10800 0 -03}
- {1427590800 -7200 1 -02}
- {1445734800 -10800 0 -03}
- {1459040400 -7200 1 -02}
- {1477789200 -10800 0 -03}
- {1490490000 -7200 1 -02}
- {1509238800 -10800 0 -03}
- {1521939600 -7200 1 -02}
- {1540688400 -10800 0 -03}
- {1553994000 -7200 1 -02}
- {1572138000 -10800 0 -03}
- {1585443600 -7200 1 -02}
- {1603587600 -10800 0 -03}
- {1616893200 -7200 1 -02}
- {1635642000 -10800 0 -03}
- {1648342800 -7200 1 -02}
- {1667091600 -10800 0 -03}
- {1679792400 -7200 1 -02}
- {1698541200 -10800 0 -03}
- {1711846800 -7200 1 -02}
- {1729990800 -10800 0 -03}
- {1743296400 -7200 1 -02}
- {1761440400 -10800 0 -03}
- {1774746000 -7200 1 -02}
- {1792890000 -10800 0 -03}
- {1806195600 -7200 1 -02}
- {1824944400 -10800 0 -03}
- {1837645200 -7200 1 -02}
- {1856394000 -10800 0 -03}
- {1869094800 -7200 1 -02}
- {1887843600 -10800 0 -03}
- {1901149200 -7200 1 -02}
- {1919293200 -10800 0 -03}
- {1932598800 -7200 1 -02}
- {1950742800 -10800 0 -03}
- {1964048400 -7200 1 -02}
- {1982797200 -10800 0 -03}
- {1995498000 -7200 1 -02}
- {2014246800 -10800 0 -03}
- {2026947600 -7200 1 -02}
- {2045696400 -10800 0 -03}
- {2058397200 -7200 1 -02}
- {2077146000 -10800 0 -03}
- {2090451600 -7200 1 -02}
- {2108595600 -10800 0 -03}
- {2121901200 -7200 1 -02}
- {2140045200 -10800 0 -03}
- {2153350800 -7200 1 -02}
- {2172099600 -10800 0 -03}
- {2184800400 -7200 1 -02}
- {2203549200 -10800 0 -03}
- {2216250000 -7200 1 -02}
- {2234998800 -10800 0 -03}
- {2248304400 -7200 1 -02}
- {2266448400 -10800 0 -03}
- {2279754000 -7200 1 -02}
- {2297898000 -10800 0 -03}
- {2311203600 -7200 1 -02}
- {2329347600 -10800 0 -03}
- {2342653200 -7200 1 -02}
- {2361402000 -10800 0 -03}
- {2374102800 -7200 1 -02}
- {2392851600 -10800 0 -03}
- {2405552400 -7200 1 -02}
- {2424301200 -10800 0 -03}
- {2437606800 -7200 1 -02}
- {2455750800 -10800 0 -03}
- {2469056400 -7200 1 -02}
- {2487200400 -10800 0 -03}
- {2500506000 -7200 1 -02}
- {2519254800 -10800 0 -03}
- {2531955600 -7200 1 -02}
- {2550704400 -10800 0 -03}
- {2563405200 -7200 1 -02}
- {2582154000 -10800 0 -03}
- {2595459600 -7200 1 -02}
- {2613603600 -10800 0 -03}
- {2626909200 -7200 1 -02}
- {2645053200 -10800 0 -03}
- {2658358800 -7200 1 -02}
- {2676502800 -10800 0 -03}
- {2689808400 -7200 1 -02}
- {2708557200 -10800 0 -03}
- {2721258000 -7200 1 -02}
- {2740006800 -10800 0 -03}
- {2752707600 -7200 1 -02}
- {2771456400 -10800 0 -03}
- {2784762000 -7200 1 -02}
- {2802906000 -10800 0 -03}
- {2816211600 -7200 1 -02}
- {2834355600 -10800 0 -03}
- {2847661200 -7200 1 -02}
- {2866410000 -10800 0 -03}
- {2879110800 -7200 1 -02}
- {2897859600 -10800 0 -03}
- {2910560400 -7200 1 -02}
- {2929309200 -10800 0 -03}
- {2942010000 -7200 1 -02}
- {2960758800 -10800 0 -03}
- {2974064400 -7200 1 -02}
- {2992208400 -10800 0 -03}
- {3005514000 -7200 1 -02}
- {3023658000 -10800 0 -03}
- {3036963600 -7200 1 -02}
- {3055712400 -10800 0 -03}
- {3068413200 -7200 1 -02}
- {3087162000 -10800 0 -03}
- {3099862800 -7200 1 -02}
- {3118611600 -10800 0 -03}
- {3131917200 -7200 1 -02}
- {3150061200 -10800 0 -03}
- {3163366800 -7200 1 -02}
- {3181510800 -10800 0 -03}
- {3194816400 -7200 1 -02}
- {3212960400 -10800 0 -03}
- {3226266000 -7200 1 -02}
- {3245014800 -10800 0 -03}
- {3257715600 -7200 1 -02}
- {3276464400 -10800 0 -03}
- {3289165200 -7200 1 -02}
- {3307914000 -10800 0 -03}
- {3321219600 -7200 1 -02}
- {3339363600 -10800 0 -03}
- {3352669200 -7200 1 -02}
- {3370813200 -10800 0 -03}
- {3384118800 -7200 1 -02}
- {3402867600 -10800 0 -03}
- {3415568400 -7200 1 -02}
- {3434317200 -10800 0 -03}
- {3447018000 -7200 1 -02}
- {3465766800 -10800 0 -03}
- {3479072400 -7200 1 -02}
- {3497216400 -10800 0 -03}
- {3510522000 -7200 1 -02}
- {3528666000 -10800 0 -03}
- {3541971600 -7200 1 -02}
- {3560115600 -10800 0 -03}
- {3573421200 -7200 1 -02}
- {3592170000 -10800 0 -03}
- {3604870800 -7200 1 -02}
- {3623619600 -10800 0 -03}
- {3636320400 -7200 1 -02}
- {3655069200 -10800 0 -03}
- {3668374800 -7200 1 -02}
- {3686518800 -10800 0 -03}
- {3699824400 -7200 1 -02}
- {3717968400 -10800 0 -03}
- {3731274000 -7200 1 -02}
- {3750022800 -10800 0 -03}
- {3762723600 -7200 1 -02}
- {3781472400 -10800 0 -03}
- {3794173200 -7200 1 -02}
- {3812922000 -10800 0 -03}
- {3825622800 -7200 1 -02}
- {3844371600 -10800 0 -03}
- {3857677200 -7200 1 -02}
- {3875821200 -10800 0 -03}
- {3889126800 -7200 1 -02}
- {3907270800 -10800 0 -03}
- {3920576400 -7200 1 -02}
- {3939325200 -10800 0 -03}
- {3952026000 -7200 1 -02}
- {3970774800 -10800 0 -03}
- {3983475600 -7200 1 -02}
- {4002224400 -10800 0 -03}
- {4015530000 -7200 1 -02}
- {4033674000 -10800 0 -03}
- {4046979600 -7200 1 -02}
- {4065123600 -10800 0 -03}
- {4078429200 -7200 1 -02}
- {4096573200 -10800 0 -03}
+if {![info exists TZData(America/Nuuk)]} {
+ LoadTimeZoneFile America/Nuuk
}
+set TZData(:America/Godthab) $TZData(:America/Nuuk)
diff --git a/library/tzdata/America/Nuuk b/library/tzdata/America/Nuuk
new file mode 100644
index 0000000..8d85a81
--- /dev/null
+++ b/library/tzdata/America/Nuuk
@@ -0,0 +1,246 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Nuuk) {
+ {-9223372036854775808 -12416 0 LMT}
+ {-1686083584 -10800 0 -03}
+ {323845200 -7200 0 -02}
+ {338950800 -10800 0 -03}
+ {354675600 -7200 1 -02}
+ {370400400 -10800 0 -03}
+ {386125200 -7200 1 -02}
+ {401850000 -10800 0 -03}
+ {417574800 -7200 1 -02}
+ {433299600 -10800 0 -03}
+ {449024400 -7200 1 -02}
+ {465354000 -10800 0 -03}
+ {481078800 -7200 1 -02}
+ {496803600 -10800 0 -03}
+ {512528400 -7200 1 -02}
+ {528253200 -10800 0 -03}
+ {543978000 -7200 1 -02}
+ {559702800 -10800 0 -03}
+ {575427600 -7200 1 -02}
+ {591152400 -10800 0 -03}
+ {606877200 -7200 1 -02}
+ {622602000 -10800 0 -03}
+ {638326800 -7200 1 -02}
+ {654656400 -10800 0 -03}
+ {670381200 -7200 1 -02}
+ {686106000 -10800 0 -03}
+ {701830800 -7200 1 -02}
+ {717555600 -10800 0 -03}
+ {733280400 -7200 1 -02}
+ {749005200 -10800 0 -03}
+ {764730000 -7200 1 -02}
+ {780454800 -10800 0 -03}
+ {796179600 -7200 1 -02}
+ {811904400 -10800 0 -03}
+ {828234000 -7200 1 -02}
+ {846378000 -10800 0 -03}
+ {859683600 -7200 1 -02}
+ {877827600 -10800 0 -03}
+ {891133200 -7200 1 -02}
+ {909277200 -10800 0 -03}
+ {922582800 -7200 1 -02}
+ {941331600 -10800 0 -03}
+ {954032400 -7200 1 -02}
+ {972781200 -10800 0 -03}
+ {985482000 -7200 1 -02}
+ {1004230800 -10800 0 -03}
+ {1017536400 -7200 1 -02}
+ {1035680400 -10800 0 -03}
+ {1048986000 -7200 1 -02}
+ {1067130000 -10800 0 -03}
+ {1080435600 -7200 1 -02}
+ {1099184400 -10800 0 -03}
+ {1111885200 -7200 1 -02}
+ {1130634000 -10800 0 -03}
+ {1143334800 -7200 1 -02}
+ {1162083600 -10800 0 -03}
+ {1174784400 -7200 1 -02}
+ {1193533200 -10800 0 -03}
+ {1206838800 -7200 1 -02}
+ {1224982800 -10800 0 -03}
+ {1238288400 -7200 1 -02}
+ {1256432400 -10800 0 -03}
+ {1269738000 -7200 1 -02}
+ {1288486800 -10800 0 -03}
+ {1301187600 -7200 1 -02}
+ {1319936400 -10800 0 -03}
+ {1332637200 -7200 1 -02}
+ {1351386000 -10800 0 -03}
+ {1364691600 -7200 1 -02}
+ {1382835600 -10800 0 -03}
+ {1396141200 -7200 1 -02}
+ {1414285200 -10800 0 -03}
+ {1427590800 -7200 1 -02}
+ {1445734800 -10800 0 -03}
+ {1459040400 -7200 1 -02}
+ {1477789200 -10800 0 -03}
+ {1490490000 -7200 1 -02}
+ {1509238800 -10800 0 -03}
+ {1521939600 -7200 1 -02}
+ {1540688400 -10800 0 -03}
+ {1553994000 -7200 1 -02}
+ {1572138000 -10800 0 -03}
+ {1585443600 -7200 1 -02}
+ {1603587600 -10800 0 -03}
+ {1616893200 -7200 1 -02}
+ {1635642000 -10800 0 -03}
+ {1648342800 -7200 1 -02}
+ {1667091600 -10800 0 -03}
+ {1679792400 -7200 1 -02}
+ {1698541200 -10800 0 -03}
+ {1711846800 -7200 1 -02}
+ {1729990800 -10800 0 -03}
+ {1743296400 -7200 1 -02}
+ {1761440400 -10800 0 -03}
+ {1774746000 -7200 1 -02}
+ {1792890000 -10800 0 -03}
+ {1806195600 -7200 1 -02}
+ {1824944400 -10800 0 -03}
+ {1837645200 -7200 1 -02}
+ {1856394000 -10800 0 -03}
+ {1869094800 -7200 1 -02}
+ {1887843600 -10800 0 -03}
+ {1901149200 -7200 1 -02}
+ {1919293200 -10800 0 -03}
+ {1932598800 -7200 1 -02}
+ {1950742800 -10800 0 -03}
+ {1964048400 -7200 1 -02}
+ {1982797200 -10800 0 -03}
+ {1995498000 -7200 1 -02}
+ {2014246800 -10800 0 -03}
+ {2026947600 -7200 1 -02}
+ {2045696400 -10800 0 -03}
+ {2058397200 -7200 1 -02}
+ {2077146000 -10800 0 -03}
+ {2090451600 -7200 1 -02}
+ {2108595600 -10800 0 -03}
+ {2121901200 -7200 1 -02}
+ {2140045200 -10800 0 -03}
+ {2153350800 -7200 1 -02}
+ {2172099600 -10800 0 -03}
+ {2184800400 -7200 1 -02}
+ {2203549200 -10800 0 -03}
+ {2216250000 -7200 1 -02}
+ {2234998800 -10800 0 -03}
+ {2248304400 -7200 1 -02}
+ {2266448400 -10800 0 -03}
+ {2279754000 -7200 1 -02}
+ {2297898000 -10800 0 -03}
+ {2311203600 -7200 1 -02}
+ {2329347600 -10800 0 -03}
+ {2342653200 -7200 1 -02}
+ {2361402000 -10800 0 -03}
+ {2374102800 -7200 1 -02}
+ {2392851600 -10800 0 -03}
+ {2405552400 -7200 1 -02}
+ {2424301200 -10800 0 -03}
+ {2437606800 -7200 1 -02}
+ {2455750800 -10800 0 -03}
+ {2469056400 -7200 1 -02}
+ {2487200400 -10800 0 -03}
+ {2500506000 -7200 1 -02}
+ {2519254800 -10800 0 -03}
+ {2531955600 -7200 1 -02}
+ {2550704400 -10800 0 -03}
+ {2563405200 -7200 1 -02}
+ {2582154000 -10800 0 -03}
+ {2595459600 -7200 1 -02}
+ {2613603600 -10800 0 -03}
+ {2626909200 -7200 1 -02}
+ {2645053200 -10800 0 -03}
+ {2658358800 -7200 1 -02}
+ {2676502800 -10800 0 -03}
+ {2689808400 -7200 1 -02}
+ {2708557200 -10800 0 -03}
+ {2721258000 -7200 1 -02}
+ {2740006800 -10800 0 -03}
+ {2752707600 -7200 1 -02}
+ {2771456400 -10800 0 -03}
+ {2784762000 -7200 1 -02}
+ {2802906000 -10800 0 -03}
+ {2816211600 -7200 1 -02}
+ {2834355600 -10800 0 -03}
+ {2847661200 -7200 1 -02}
+ {2866410000 -10800 0 -03}
+ {2879110800 -7200 1 -02}
+ {2897859600 -10800 0 -03}
+ {2910560400 -7200 1 -02}
+ {2929309200 -10800 0 -03}
+ {2942010000 -7200 1 -02}
+ {2960758800 -10800 0 -03}
+ {2974064400 -7200 1 -02}
+ {2992208400 -10800 0 -03}
+ {3005514000 -7200 1 -02}
+ {3023658000 -10800 0 -03}
+ {3036963600 -7200 1 -02}
+ {3055712400 -10800 0 -03}
+ {3068413200 -7200 1 -02}
+ {3087162000 -10800 0 -03}
+ {3099862800 -7200 1 -02}
+ {3118611600 -10800 0 -03}
+ {3131917200 -7200 1 -02}
+ {3150061200 -10800 0 -03}
+ {3163366800 -7200 1 -02}
+ {3181510800 -10800 0 -03}
+ {3194816400 -7200 1 -02}
+ {3212960400 -10800 0 -03}
+ {3226266000 -7200 1 -02}
+ {3245014800 -10800 0 -03}
+ {3257715600 -7200 1 -02}
+ {3276464400 -10800 0 -03}
+ {3289165200 -7200 1 -02}
+ {3307914000 -10800 0 -03}
+ {3321219600 -7200 1 -02}
+ {3339363600 -10800 0 -03}
+ {3352669200 -7200 1 -02}
+ {3370813200 -10800 0 -03}
+ {3384118800 -7200 1 -02}
+ {3402867600 -10800 0 -03}
+ {3415568400 -7200 1 -02}
+ {3434317200 -10800 0 -03}
+ {3447018000 -7200 1 -02}
+ {3465766800 -10800 0 -03}
+ {3479072400 -7200 1 -02}
+ {3497216400 -10800 0 -03}
+ {3510522000 -7200 1 -02}
+ {3528666000 -10800 0 -03}
+ {3541971600 -7200 1 -02}
+ {3560115600 -10800 0 -03}
+ {3573421200 -7200 1 -02}
+ {3592170000 -10800 0 -03}
+ {3604870800 -7200 1 -02}
+ {3623619600 -10800 0 -03}
+ {3636320400 -7200 1 -02}
+ {3655069200 -10800 0 -03}
+ {3668374800 -7200 1 -02}
+ {3686518800 -10800 0 -03}
+ {3699824400 -7200 1 -02}
+ {3717968400 -10800 0 -03}
+ {3731274000 -7200 1 -02}
+ {3750022800 -10800 0 -03}
+ {3762723600 -7200 1 -02}
+ {3781472400 -10800 0 -03}
+ {3794173200 -7200 1 -02}
+ {3812922000 -10800 0 -03}
+ {3825622800 -7200 1 -02}
+ {3844371600 -10800 0 -03}
+ {3857677200 -7200 1 -02}
+ {3875821200 -10800 0 -03}
+ {3889126800 -7200 1 -02}
+ {3907270800 -10800 0 -03}
+ {3920576400 -7200 1 -02}
+ {3939325200 -10800 0 -03}
+ {3952026000 -7200 1 -02}
+ {3970774800 -10800 0 -03}
+ {3983475600 -7200 1 -02}
+ {4002224400 -10800 0 -03}
+ {4015530000 -7200 1 -02}
+ {4033674000 -10800 0 -03}
+ {4046979600 -7200 1 -02}
+ {4065123600 -10800 0 -03}
+ {4078429200 -7200 1 -02}
+ {4096573200 -10800 0 -03}
+}
diff --git a/library/tzdata/America/Whitehorse b/library/tzdata/America/Whitehorse
index 1d61093..da0c0f0 100644
--- a/library/tzdata/America/Whitehorse
+++ b/library/tzdata/America/Whitehorse
@@ -93,164 +93,5 @@ set TZData(:America/Whitehorse) {
{1541322000 -28800 0 PST}
{1552212000 -25200 1 PDT}
{1572771600 -28800 0 PST}
- {1583661600 -25200 1 PDT}
- {1604221200 -28800 0 PST}
- {1615716000 -25200 1 PDT}
- {1636275600 -28800 0 PST}
- {1647165600 -25200 1 PDT}
- {1667725200 -28800 0 PST}
- {1678615200 -25200 1 PDT}
- {1699174800 -28800 0 PST}
- {1710064800 -25200 1 PDT}
- {1730624400 -28800 0 PST}
- {1741514400 -25200 1 PDT}
- {1762074000 -28800 0 PST}
- {1772964000 -25200 1 PDT}
- {1793523600 -28800 0 PST}
- {1805018400 -25200 1 PDT}
- {1825578000 -28800 0 PST}
- {1836468000 -25200 1 PDT}
- {1857027600 -28800 0 PST}
- {1867917600 -25200 1 PDT}
- {1888477200 -28800 0 PST}
- {1899367200 -25200 1 PDT}
- {1919926800 -28800 0 PST}
- {1930816800 -25200 1 PDT}
- {1951376400 -28800 0 PST}
- {1962871200 -25200 1 PDT}
- {1983430800 -28800 0 PST}
- {1994320800 -25200 1 PDT}
- {2014880400 -28800 0 PST}
- {2025770400 -25200 1 PDT}
- {2046330000 -28800 0 PST}
- {2057220000 -25200 1 PDT}
- {2077779600 -28800 0 PST}
- {2088669600 -25200 1 PDT}
- {2109229200 -28800 0 PST}
- {2120119200 -25200 1 PDT}
- {2140678800 -28800 0 PST}
- {2152173600 -25200 1 PDT}
- {2172733200 -28800 0 PST}
- {2183623200 -25200 1 PDT}
- {2204182800 -28800 0 PST}
- {2215072800 -25200 1 PDT}
- {2235632400 -28800 0 PST}
- {2246522400 -25200 1 PDT}
- {2267082000 -28800 0 PST}
- {2277972000 -25200 1 PDT}
- {2298531600 -28800 0 PST}
- {2309421600 -25200 1 PDT}
- {2329981200 -28800 0 PST}
- {2341476000 -25200 1 PDT}
- {2362035600 -28800 0 PST}
- {2372925600 -25200 1 PDT}
- {2393485200 -28800 0 PST}
- {2404375200 -25200 1 PDT}
- {2424934800 -28800 0 PST}
- {2435824800 -25200 1 PDT}
- {2456384400 -28800 0 PST}
- {2467274400 -25200 1 PDT}
- {2487834000 -28800 0 PST}
- {2499328800 -25200 1 PDT}
- {2519888400 -28800 0 PST}
- {2530778400 -25200 1 PDT}
- {2551338000 -28800 0 PST}
- {2562228000 -25200 1 PDT}
- {2582787600 -28800 0 PST}
- {2593677600 -25200 1 PDT}
- {2614237200 -28800 0 PST}
- {2625127200 -25200 1 PDT}
- {2645686800 -28800 0 PST}
- {2656576800 -25200 1 PDT}
- {2677136400 -28800 0 PST}
- {2688631200 -25200 1 PDT}
- {2709190800 -28800 0 PST}
- {2720080800 -25200 1 PDT}
- {2740640400 -28800 0 PST}
- {2751530400 -25200 1 PDT}
- {2772090000 -28800 0 PST}
- {2782980000 -25200 1 PDT}
- {2803539600 -28800 0 PST}
- {2814429600 -25200 1 PDT}
- {2834989200 -28800 0 PST}
- {2846484000 -25200 1 PDT}
- {2867043600 -28800 0 PST}
- {2877933600 -25200 1 PDT}
- {2898493200 -28800 0 PST}
- {2909383200 -25200 1 PDT}
- {2929942800 -28800 0 PST}
- {2940832800 -25200 1 PDT}
- {2961392400 -28800 0 PST}
- {2972282400 -25200 1 PDT}
- {2992842000 -28800 0 PST}
- {3003732000 -25200 1 PDT}
- {3024291600 -28800 0 PST}
- {3035786400 -25200 1 PDT}
- {3056346000 -28800 0 PST}
- {3067236000 -25200 1 PDT}
- {3087795600 -28800 0 PST}
- {3098685600 -25200 1 PDT}
- {3119245200 -28800 0 PST}
- {3130135200 -25200 1 PDT}
- {3150694800 -28800 0 PST}
- {3161584800 -25200 1 PDT}
- {3182144400 -28800 0 PST}
- {3193034400 -25200 1 PDT}
- {3213594000 -28800 0 PST}
- {3225088800 -25200 1 PDT}
- {3245648400 -28800 0 PST}
- {3256538400 -25200 1 PDT}
- {3277098000 -28800 0 PST}
- {3287988000 -25200 1 PDT}
- {3308547600 -28800 0 PST}
- {3319437600 -25200 1 PDT}
- {3339997200 -28800 0 PST}
- {3350887200 -25200 1 PDT}
- {3371446800 -28800 0 PST}
- {3382941600 -25200 1 PDT}
- {3403501200 -28800 0 PST}
- {3414391200 -25200 1 PDT}
- {3434950800 -28800 0 PST}
- {3445840800 -25200 1 PDT}
- {3466400400 -28800 0 PST}
- {3477290400 -25200 1 PDT}
- {3497850000 -28800 0 PST}
- {3508740000 -25200 1 PDT}
- {3529299600 -28800 0 PST}
- {3540189600 -25200 1 PDT}
- {3560749200 -28800 0 PST}
- {3572244000 -25200 1 PDT}
- {3592803600 -28800 0 PST}
- {3603693600 -25200 1 PDT}
- {3624253200 -28800 0 PST}
- {3635143200 -25200 1 PDT}
- {3655702800 -28800 0 PST}
- {3666592800 -25200 1 PDT}
- {3687152400 -28800 0 PST}
- {3698042400 -25200 1 PDT}
- {3718602000 -28800 0 PST}
- {3730096800 -25200 1 PDT}
- {3750656400 -28800 0 PST}
- {3761546400 -25200 1 PDT}
- {3782106000 -28800 0 PST}
- {3792996000 -25200 1 PDT}
- {3813555600 -28800 0 PST}
- {3824445600 -25200 1 PDT}
- {3845005200 -28800 0 PST}
- {3855895200 -25200 1 PDT}
- {3876454800 -28800 0 PST}
- {3887344800 -25200 1 PDT}
- {3907904400 -28800 0 PST}
- {3919399200 -25200 1 PDT}
- {3939958800 -28800 0 PST}
- {3950848800 -25200 1 PDT}
- {3971408400 -28800 0 PST}
- {3982298400 -25200 1 PDT}
- {4002858000 -28800 0 PST}
- {4013748000 -25200 1 PDT}
- {4034307600 -28800 0 PST}
- {4045197600 -25200 1 PDT}
- {4065757200 -28800 0 PST}
- {4076647200 -25200 1 PDT}
- {4097206800 -28800 0 PST}
+ {1583661600 -25200 0 MST}
}
diff --git a/library/tzdata/Asia/Shanghai b/library/tzdata/Asia/Shanghai
index 66bc4339..0fcf802 100644
--- a/library/tzdata/Asia/Shanghai
+++ b/library/tzdata/Asia/Shanghai
@@ -3,6 +3,8 @@
set TZData(:Asia/Shanghai) {
{-9223372036854775808 29143 0 LMT}
{-2177481943 28800 0 CST}
+ {-1600675200 32400 1 CDT}
+ {-1585904400 28800 0 CST}
{-933667200 32400 1 CDT}
{-922093200 28800 0 CST}
{-908870400 32400 1 CDT}
diff --git a/library/word.tcl b/library/word.tcl
index 0246530..0d66a32 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -136,7 +136,9 @@ proc tcl_startOfNextWord {str start} {
proc tcl_startOfPreviousWord {str start} {
variable ::tcl::WordBreakRE
set word {-1 -1}
- regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
- result word
+ if {$start > 0} {
+ regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
+ result word
+ }
return [lindex $word 0]
}
diff --git a/libtommath/libtommath_VS2008.sln b/libtommath/libtommath_VS2008.sln
index 6bfc159..3bd6688 100644
--- a/libtommath/libtommath_VS2008.sln
+++ b/libtommath/libtommath_VS2008.sln
@@ -1,4 +1,4 @@
-
+
Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "tommath", "libtommath_VS2008.vcproj", "{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}"
diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj
index a83d100..d7d23fb 100644
--- a/macosx/Tcl.xcode/project.pbxproj
+++ b/macosx/Tcl.xcode/project.pbxproj
@@ -263,7 +263,7 @@
F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = "<group>"; };
F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = "<group>"; };
F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = "<group>"; };
- F96D3E2208F272A5004A47F5 /* CrtSlave.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtSlave.3; sourceTree = "<group>"; };
+ F96D3E2208F272A5004A47F5 /* CrtAlias.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtAlias.3; sourceTree = "<group>"; };
F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = "<group>"; };
F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = "<group>"; };
F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = "<group>"; };
@@ -1010,7 +1010,7 @@
F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */,
F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */,
F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */,
- F96D3E2208F272A5004A47F5 /* CrtSlave.3 */,
+ F96D3E2208F272A5004A47F5 /* CrtAlias.3 */,
F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */,
F96D3E2408F272A5004A47F5 /* CrtTrace.3 */,
F96D3E2508F272A5004A47F5 /* dde.n */,
@@ -1904,7 +1904,7 @@
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/bash;
- shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.2\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
+ shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.5\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
showEnvVarsInLog = 0;
};
F97AF02F0B665DA900310EA2 /* Build Tcl */ = {
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
index b1c3a39..1d200a0 100644
--- a/macosx/Tcl.xcodeproj/project.pbxproj
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -262,7 +262,7 @@
F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = "<group>"; };
F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = "<group>"; };
F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = "<group>"; };
- F96D3E2208F272A5004A47F5 /* CrtSlave.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtSlave.3; sourceTree = "<group>"; };
+ F96D3E2208F272A5004A47F5 /* CrtAlias.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtAlias.3; sourceTree = "<group>"; };
F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = "<group>"; };
F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = "<group>"; };
F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = "<group>"; };
@@ -1010,7 +1010,7 @@
F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */,
F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */,
F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */,
- F96D3E2208F272A5004A47F5 /* CrtSlave.3 */,
+ F96D3E2208F272A5004A47F5 /* CrtAlias.3 */,
F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */,
F96D3E2408F272A5004A47F5 /* CrtTrace.3 */,
F96D3E2508F272A5004A47F5 /* dde.n */,
@@ -1904,7 +1904,7 @@
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/bash;
- shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.2\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
+ shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.5\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
showEnvVarsInLog = 0;
};
F97AF02F0B665DA900310EA2 /* Build Tcl */ = {
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index 8f1dbba..ee271e1 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -14,6 +14,18 @@
*/
#include "tclInt.h"
+
+/*
+ * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the
+ * OSSpinLock, and the OSSpinLock was deprecated.
+ */
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200
+#define USE_OS_UNFAIR_LOCK
+#include <os/lock.h>
+#undef TCL_MAC_DEBUG_NOTIFIER
+#endif
+
#ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is
* in tclUnixNotfy.c */
#include <CoreFoundation/CoreFoundation.h>
@@ -21,6 +33,8 @@
/* #define TCL_MAC_DEBUG_NOTIFIER 1 */
+#if !defined(USE_OS_UNFAIR_LOCK)
+
/*
* We use the Darwin-native spinlock API rather than pthread mutexes for
* notifier locking: this radically simplifies the implementation and lowers
@@ -172,26 +186,45 @@ SpinLockTry(
#pragma GCC diagnostic pop
#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
+#endif /* not using os_unfair_lock */
/*
- * These spinlocks lock access to the global notifier state.
+ * These locks control access to the global notifier state.
*/
+#if defined(USE_OS_UNFAIR_LOCK)
+static os_unfair_lock notifierInitLock = OS_UNFAIR_LOCK_INIT;
+static os_unfair_lock notifierLock = OS_UNFAIR_LOCK_INIT;
+#else
static OSSpinLock notifierInitLock = SPINLOCK_INIT;
static OSSpinLock notifierLock = SPINLOCK_INIT;
+#endif
/*
- * Macros abstracting notifier locking/unlocking
+ * Macros that abstract notifier locking/unlocking
*/
+#if defined(USE_OS_UNFAIR_LOCK)
+#define LOCK_NOTIFIER_INIT os_unfair_lock_lock(&notifierInitLock)
+#define UNLOCK_NOTIFIER_INIT os_unfair_lock_unlock(&notifierInitLock)
+#define LOCK_NOTIFIER os_unfair_lock_lock(&notifierLock)
+#define UNLOCK_NOTIFIER os_unfair_lock_unlock(&notifierLock)
+#define LOCK_NOTIFIER_TSD os_unfair_lock_lock(&tsdPtr->tsdLock)
+#define UNLOCK_NOTIFIER_TSD os_unfair_lock_unlock(&tsdPtr->tsdLock)
+#else
#define LOCK_NOTIFIER_INIT SpinLockLock(&notifierInitLock)
#define UNLOCK_NOTIFIER_INIT SpinLockUnlock(&notifierInitLock)
#define LOCK_NOTIFIER SpinLockLock(&notifierLock)
#define UNLOCK_NOTIFIER SpinLockUnlock(&notifierLock)
#define LOCK_NOTIFIER_TSD SpinLockLock(&tsdPtr->tsdLock)
#define UNLOCK_NOTIFIER_TSD SpinLockUnlock(&tsdPtr->tsdLock)
+#endif
-#ifdef TCL_MAC_DEBUG_NOTIFIER
+/*
+ * The debug version of the Notifier only works if using OSSpinLock.
+ */
+
+#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
#define TclMacOSXNotifierDbgMsg(m, ...) \
do { \
fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \
@@ -218,7 +251,7 @@ static OSSpinLock notifierLock = SPINLOCK_INIT;
#undef LOCK_NOTIFIER
#define LOCK_NOTIFIER SpinLockLockDbg(&notifierLock)
#undef LOCK_NOTIFIER_TSD
-#define LOCK_NOTIFIER_TSD SpinLockLockDbg(&tsdPtr->tsdLock)
+#define LOCK_NOTIFIER_TSD SpinLockLockDbg(tsdPtr->tsdLock)
#include <asl.h>
static FILE *notifierLog = NULL;
#ifndef NOTIFIER_LOG
@@ -325,8 +358,6 @@ typedef struct ThreadSpecificData {
int runLoopRunning; /* True if this thread's Tcl runLoop is
* running. */
int runLoopNestingLevel; /* Level of nested runLoop invocations. */
- int runLoopServicingEvents; /* True if this thread's runLoop is servicing
- * Tcl events. */
/* Must hold the notifierLock before accessing the following fields: */
/* Start notifierLock section */
@@ -339,9 +370,14 @@ typedef struct ThreadSpecificData {
* from these pointers. */
/* End notifierLock section */
+#if defined(USE_OS_UNFAIR_LOCK)
+ os_unfair_lock tsdLock;
+#else
OSSpinLock tsdLock; /* Must hold this lock before acessing the
* following fields from more than one
* thread. */
+#endif
+
/* Start tsdLock section */
SelectMasks checkMasks; /* This structure is used to build up the
* masks to be used in the next call to
@@ -526,7 +562,6 @@ Tcl_InitNotifier(void)
/*
* Initialize support for weakly imported spinlock API.
*/
-
if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
}
@@ -563,7 +598,7 @@ Tcl_InitNotifier(void)
bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext));
runLoopObserverContext.info = tsdPtr;
runLoopObserver = CFRunLoopObserverCreate(NULL,
- kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+ kCFRunLoopEntry|kCFRunLoopExit, TRUE,
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserver) {
@@ -581,7 +616,7 @@ Tcl_InitNotifier(void)
*/
runLoopObserverTcl = CFRunLoopObserverCreate(NULL,
- kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+ kCFRunLoopEntry|kCFRunLoopExit, TRUE,
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserverTcl) {
@@ -597,7 +632,11 @@ Tcl_InitNotifier(void)
tsdPtr->runLoopObserverTcl = runLoopObserverTcl;
tsdPtr->runLoopTimer = NULL;
tsdPtr->waitTime = CF_TIMEINTERVAL_FOREVER;
+#if defined(USE_OS_UNFAIR_LOCK)
+ tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
+#else
tsdPtr->tsdLock = SPINLOCK_INIT;
+#endif
}
LOCK_NOTIFIER_INIT;
@@ -655,7 +694,6 @@ Tcl_InitNotifier(void)
ENABLE_ASL;
notifierCount++;
UNLOCK_NOTIFIER_INIT;
-
return tsdPtr;
}
@@ -1291,6 +1329,10 @@ Tcl_WaitForEvent(
Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");
}
+ /*
+ * A NULL timePtr means wait forever.
+ */
+
if (timePtr) {
Tcl_Time vTime = *timePtr;
@@ -1304,14 +1346,23 @@ Tcl_WaitForEvent(
tclScaleTimeProcPtr(&vTime, tclTimeClientData);
waitTime = vTime.sec + 1.0e-6 * vTime.usec;
} else {
+
/*
- * Polling: pretend to wait for files and tell the notifier thread
- * what we are doing. The notifier thread makes sure it goes
- * through select with its select mask in the same state as ours
- * currently is. We block until that happens.
+ * The max block time was set to 0.
+ *
+ * If we set the waitTime to 0, then the call to CFRunLoopInMode
+ * may return without processing all of its sources. The Apple
+ * documentation says that if the waitTime is 0 "only one pass is
+ * made through the run loop before returning; if multiple sources
+ * or timers are ready to fire immediately, only one (possibly two
+ * if one is a version 0 source) will be fired, regardless of the
+ * value of returnAfterSourceHandled." This can cause some chanio
+ * tests to fail. So we use a small positive waitTime unless there
+ * is another RunLoop running.
*/
polling = 1;
+ waitTime = tsdPtr->runLoopRunning ? 0 : 0.0001;
}
}
@@ -1324,18 +1375,18 @@ Tcl_WaitForEvent(
/*
* If the Tcl runloop is already running (e.g. if Tcl_WaitForEvent was
- * called recursively) or is servicing events via the runloop observer,
- * re-run it in a custom runloop mode containing only the source for the
- * notifier thread, otherwise wakeups from other sources added to the
- * common runloop modes might get lost or 3rd party event handlers might
- * get called when they do not expect to be.
+ * called recursively) start a new runloop in a custom runloop mode
+ * containing only the source for the notifier thread. Otherwise wakeups
+ * from other sources added to the common runloop mode might get lost or
+ * 3rd party event handlers might get called when they do not expect to
+ * be.
*/
runLoopRunning = tsdPtr->runLoopRunning;
tsdPtr->runLoopRunning = 1;
- runLoopStatus = CFRunLoopRunInMode(tsdPtr->runLoopServicingEvents ||
- runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
- waitTime, TRUE);
+ runLoopStatus = CFRunLoopRunInMode(
+ runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
+ waitTime, TRUE);
tsdPtr->runLoopRunning = runLoopRunning;
LOCK_NOTIFIER_TSD;
@@ -1453,7 +1504,6 @@ UpdateWaitingListAndServiceEvents(
void *info)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
-
if (tsdPtr->sleeping) {
return;
}
@@ -1476,19 +1526,6 @@ UpdateWaitingListAndServiceEvents(
}
tsdPtr->runLoopNestingLevel--;
break;
- case kCFRunLoopBeforeWaiting:
- if (tsdPtr->runLoopTimer && !tsdPtr->runLoopServicingEvents &&
- (tsdPtr->runLoopNestingLevel > 1
- || !tsdPtr->runLoopRunning)) {
- tsdPtr->runLoopServicingEvents = 1;
- /*
- * This call seems to simply force event processing through and
- * prevents hangups that have long been observed with Tk-Cocoa.
- */
- Tcl_ServiceAll();
- tsdPtr->runLoopServicingEvents = 0;
- }
- break;
default:
break;
}
@@ -1521,7 +1558,7 @@ OnOffWaitingList(
{
int changeWaitingList;
-#ifdef TCL_MAC_DEBUG_NOTIFIER
+#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
if (SpinLockTry(&notifierLock)) {
Tcl_Panic("OnOffWaitingList: notifierLock unlocked");
}
@@ -2052,9 +2089,19 @@ AtForkChild(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- UNLOCK_NOTIFIER_TSD;
- UNLOCK_NOTIFIER;
- UNLOCK_NOTIFIER_INIT;
+ /*
+ * If a child process unlocks an os_unfair_lock that was created in its parent
+ * the child will exit with an illegal instruction error. So we reinitialize
+ * the lock in the child rather than attempt to unlock it.
+ */
+
+#if defined(USE_OS_UNFAIR_LOCK)
+ tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
+#else
+ UNLOCK_NOTIFIER_TSD;
+ UNLOCK_NOTIFIER;
+ UNLOCK_NOTIFIER_INIT;
+#endif
if (tsdPtr->runLoop) {
tsdPtr->runLoop = NULL;
if (!noCFafterFork) {
diff --git a/pkgs/README b/pkgs/README
index 159a237..4633e0b 100644
--- a/pkgs/README
+++ b/pkgs/README
@@ -17,7 +17,7 @@ needs to conform to the following conventions.
"configure". When the program "configure" is run, it should generate
a file "Makefile" in the current working directory. The "configure"
program should be able to accept as command line arguments all the
- arguments that can be passed to the master unix/configure program. It
+ arguments that can be passed to the top unix/configure program. It
should also accept the --with-tcl= and --with-tclinclude= options in
the conventional way.
diff --git a/tests/aaa_exit.test b/tests/aaa_exit.test
index 3ba5167..d4d2a7c 100644
--- a/tests/aaa_exit.test
+++ b/tests/aaa_exit.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/all.tcl b/tests/all.tcl
index 52c8763..c72334a 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -1,7 +1,7 @@
# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
-# tests. Execute it by invoking "source all.test" when running tcltest
+# tests. Execute it by invoking "source all.tcl" when running tcltest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
diff --git a/tests/append.test b/tests/append.test
index 8fa4e61..ef4a194 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
unset -nocomplain x
diff --git a/tests/appendComp.test b/tests/appendComp.test
index bbf5f9c..66941a9 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
catch {unset x}
@@ -359,9 +359,9 @@ test appendComp-7.9 {append var does not trigger read trace} -setup {
} -result {0}
test appendComp-8.1 {defer error to runtime} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
proc foo {} {
proc append args {}
append
@@ -369,7 +369,7 @@ test appendComp-8.1 {defer error to runtime} -setup {
foo
}
} -cleanup {
- interp delete slave
+ interp delete child
} -result {}
# New tests for bug 3057639 to show off the more consistent behaviour of
diff --git a/tests/apply.test b/tests/apply.test
index 597cd97..227d3c1 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2.2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/assocd.test b/tests/assocd.test
index edf55c4..7d89daa 100644
--- a/tests/assocd.test
+++ b/tests/assocd.test
@@ -11,8 +11,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/async.test b/tests/async.test
index df13f83..ad058a0 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/auto-files.zip b/tests/auto-files.zip
new file mode 100644
index 0000000..b8bdf88
--- /dev/null
+++ b/tests/auto-files.zip
Binary files differ
diff --git a/tests/auto0/auto1/file1.tcl b/tests/auto0/auto1/file1.tcl
new file mode 100644
index 0000000..bd8b92b
--- /dev/null
+++ b/tests/auto0/auto1/file1.tcl
@@ -0,0 +1,3 @@
+proc report1 {args} {
+ return ok1
+}
diff --git a/tests/auto0/auto1/package1.tcl b/tests/auto0/auto1/package1.tcl
new file mode 100644
index 0000000..32d7c56
--- /dev/null
+++ b/tests/auto0/auto1/package1.tcl
@@ -0,0 +1,5 @@
+proc HeresPackage1 {args} {
+ return OK1
+}
+
+package provide SafeTestPackage1 1.2.3
diff --git a/tests/auto0/auto1/pkgIndex.tcl b/tests/auto0/auto1/pkgIndex.tcl
new file mode 100644
index 0000000..babb6d5
--- /dev/null
+++ b/tests/auto0/auto1/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded SafeTestPackage1 1.2.3 [list source [file join $dir package1.tcl]]
diff --git a/tests/auto0/auto1/tclIndex b/tests/auto0/auto1/tclIndex
new file mode 100644
index 0000000..bbfa6d4
--- /dev/null
+++ b/tests/auto0/auto1/tclIndex
@@ -0,0 +1,9 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(report1) [list source [file join $dir file1.tcl]]
diff --git a/tests/auto0/auto2/file2.tcl b/tests/auto0/auto2/file2.tcl
new file mode 100644
index 0000000..5bc622f
--- /dev/null
+++ b/tests/auto0/auto2/file2.tcl
@@ -0,0 +1,3 @@
+proc report2 {args} {
+ return ok2
+}
diff --git a/tests/auto0/auto2/package2.tcl b/tests/auto0/auto2/package2.tcl
new file mode 100644
index 0000000..61774df
--- /dev/null
+++ b/tests/auto0/auto2/package2.tcl
@@ -0,0 +1,5 @@
+proc HeresPackage2 {args} {
+ return OK2
+}
+
+package provide SafeTestPackage2 2.3.4
diff --git a/tests/auto0/auto2/pkgIndex.tcl b/tests/auto0/auto2/pkgIndex.tcl
new file mode 100644
index 0000000..1022691
--- /dev/null
+++ b/tests/auto0/auto2/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded SafeTestPackage2 2.3.4 [list source [file join $dir package2.tcl]]
diff --git a/tests/auto0/auto2/tclIndex b/tests/auto0/auto2/tclIndex
new file mode 100644
index 0000000..9cd2a74
--- /dev/null
+++ b/tests/auto0/auto2/tclIndex
@@ -0,0 +1,9 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(report2) [list source [file join $dir file2.tcl]]
diff --git a/tests/auto0/modules/mod1/test1-1.0.tm b/tests/auto0/modules/mod1/test1-1.0.tm
new file mode 100644
index 0000000..927fa6f
--- /dev/null
+++ b/tests/auto0/modules/mod1/test1-1.0.tm
@@ -0,0 +1,5 @@
+namespace eval mod1::test1 {}
+
+proc mod1::test1::try1 args {
+ return res1
+}
diff --git a/tests/auto0/modules/mod2/test2-2.0.tm b/tests/auto0/modules/mod2/test2-2.0.tm
new file mode 100644
index 0000000..b5cd45b
--- /dev/null
+++ b/tests/auto0/modules/mod2/test2-2.0.tm
@@ -0,0 +1,5 @@
+namespace eval mod2::test2 {}
+
+proc mod2::test2::try2 args {
+ return res2
+}
diff --git a/tests/auto0/modules/test0-0.5.tm b/tests/auto0/modules/test0-0.5.tm
new file mode 100644
index 0000000..19f3613
--- /dev/null
+++ b/tests/auto0/modules/test0-0.5.tm
@@ -0,0 +1,5 @@
+namespace eval test0 {}
+
+proc test0::try0 args {
+ return res0
+}
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index b42d50d..8662888 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -10,7 +10,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -146,10 +146,10 @@ test autoMkindex-1.3 {examine tclIndex} -setup {
test autoMkindex-2.1 {commands on the autoload path can be imported} -setup {
file delete tclIndex
- interp create slave
+ interp create child
} -body {
auto_mkindex . autoMkindex.tcl
- slave eval {
+ child eval {
namespace eval blt {}
set auto_path [linsert $auto_path 0 .]
set info [list [catch {namespace import buried::*} result] $result]
@@ -159,22 +159,22 @@ test autoMkindex-2.1 {commands on the autoload path can be imported} -setup {
return $info
}
} -cleanup {
- interp delete slave
+ interp delete child
} -result "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
# Test auto_mkindex hooks
-# Slave hook executes interesting code in the interp used to watch code.
-test autoMkindex-3.1 {slaveHook} -setup {
+# Child hook executes interesting code in the interp used to watch code.
+test autoMkindex-3.1 {childHook} -setup {
file delete tclIndex
} -body {
- auto_mkindex_parser::slavehook {
+ auto_mkindex_parser::childhook {
_%@namespace eval ::blt {
proc foo {} {}
_%@namespace export foo
}
}
- auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
+ auto_mkindex_parser::childhook { _%@namespace import -force ::blt::* }
auto_mkindex . autoMkindex.tcl
file exists tclIndex
} -cleanup {
@@ -335,14 +335,14 @@ test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup {
proc {[magic mojo proc]} {} {}
} [file join pkg magicchar2.tcl]
set result {}
- interp create slave
+ interp create child
} -body {
auto_mkindex . pkg/magicchar2.tcl
- # Make a slave interp to test the autoloading
- slave eval {lappend auto_path [pwd]}
- slave eval {catch {{[magic mojo proc]}}}
+ # Make a child interp to test the autoloading
+ child eval {lappend auto_path [pwd]}
+ child eval {catch {{[magic mojo proc]}}}
} -cleanup {
- interp delete slave
+ interp delete child
removeFile [file join pkg magicchar2.tcl]
removeDirectory pkg
} -result 0
diff --git a/tests/basic.test b/tests/basic.test
index 428fd93..38ea11e 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -15,8 +15,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -999,13 +1001,13 @@ test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
} {global}
test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup {
- interp create slave
- interp alias {} foo slave return
+ interp create child
+ interp alias {} foo child return
} -body {
list [catch foo m] $m
} -cleanup {
unset -nocomplain m
- interp delete slave
+ interp delete child
} -result {0 {}}
# Clean up after expand tests
diff --git a/tests/binary.test b/tests/binary.test
index b06afe0..cf3195f 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
diff --git a/tests/case.test b/tests/case.test
index d7558a9..87cb2c8 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -16,8 +16,8 @@ if {![llength [info commands case]]} {
return
}
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/chan.test b/tests/chan.test
index 6808453..5d05935 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -7,8 +7,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -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/chanio.test b/tests/chanio.test
index c7c07ce..daacdd0 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,13 +13,17 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-# TODO: This test is likely worthless. Confirm and remove
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
namespace eval ::tcl::test::io {
- namespace import ::tcltest::*
+
+ if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+ }
variable umaskValue
variable path
@@ -39,11 +43,12 @@ namespace eval ::tcl::test::io {
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
- testConstraint openpipe 1
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
+ testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+ testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In particular,
# many file systems do not support large-files...
@@ -448,7 +453,7 @@ test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
} -cleanup {
chan close $f
} -result [list 256 $a]
-test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
+test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body {
# if (FilterInputBytes(chanPtr, &gs) != 0)
set f [openpipe w+ $path(cat)]
chan puts -nonewline $f "hi\nwould"
@@ -709,7 +714,7 @@ test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testc
} -result [list 15 "123456789012345" 15]
test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (FilterInputBytes() != 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {crlf lf} -buffering none
@@ -849,7 +854,7 @@ test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup {
} -result {4 abcd 4 efgh 4 ijkl 4 mnop -1 {}}
test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# if (chanPtr->flags & INPUT_SAW_CR)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -867,7 +872,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# not (*eol == '\n')
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -885,7 +890,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# Tcl_ExternalToUtf()
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -903,7 +908,7 @@ test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup
} -result {15 123456789abcdef 1 4 abcd 0}
test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# memmove()
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -1021,7 +1026,7 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -buffering none
chan puts -nonewline $f "foobar"
@@ -1088,7 +1093,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
@@ -1122,7 +1127,7 @@ test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constrai
} -result 7
test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
variable x {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# not (bufPtr->nextPtr == NULL)
set f [openpipe w+ $path(cat)]
chan configure $f -translation lf -encoding ascii -buffering none
@@ -1139,7 +1144,7 @@ test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
} -cleanup {
chan close $f
} -result {-1 {} 42 15 123456789012345 25}
-test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel fileevent} -body {
# (bytesLeft == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
@@ -1168,7 +1173,7 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
chan close $f
} -result $a
unset a
-test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel fileevent} -body {
# (bufPtr->nextAdded < bufPtr->length)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
@@ -1179,7 +1184,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {st
} -cleanup {
chan close $f
} -result {15 abcdefghijklmno 1}
-test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel fileevent} -body {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffersize 16
@@ -1192,7 +1197,7 @@ test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio te
} -result {15 abcdefghijklmno 1}
test chan-io-8.7 {PeekAhead: cleanup} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# Make sure bytes are removed from buffer.
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffering none
@@ -1343,7 +1348,7 @@ test chan-io-12.3 {ReadChars: allocate more space} -body {
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-12.4 {ReadChars: split-up char} -setup {
variable x {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (srcRead == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none -buffersize 16
@@ -1365,7 +1370,7 @@ test chan-io-12.4 {ReadChars: split-up char} -setup {
} -result [list "123456789012345" 1 "\u672c" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
chan gets stdin; chan puts -nonewline "\xe7"
@@ -1458,7 +1463,7 @@ test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
variable x {}
variable y {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
set f [openpipe w+ $path(cat)]
@@ -1476,7 +1481,7 @@ test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup
} -cleanup {
chan close $f
} -result [list "abcdefghj\n" 1 "01234" 0]
-test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints {testchannel openpipe} -body {
+test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints testchannel -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1577,7 +1582,7 @@ test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup {
interp delete x
} -result {line line none}
set path(test3) [makeFile {} test3]
-test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec openpipe} -body {
+test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints exec -body {
set f [open $path(test1) w]
chan puts -nonewline $f {
chan close stdin
@@ -1674,7 +1679,7 @@ set path(script) [makeFile {} script]
test chan-io-14.8 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stderr
@@ -1697,7 +1702,7 @@ test chan-io-14.8 {reuse of stdio special channels} -setup {
test chan-io-14.9 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [open $path(script) w]
chan puts $f {
array set path [lindex $argv 0]
@@ -1881,7 +1886,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
-} -constraints {stdio openpipe knownMsvcBug} -body {
+} -constraints {stdio knownMsvcBug} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -1966,7 +1971,7 @@ test chan-io-26.1 {Tcl_GetChannelInstanceData} -body {
# Don't care what pid is (but must be a number), just want to exercise it.
set f [openpipe r << exit]
pid $f
-} -constraints {stdio openpipe} -cleanup {
+} -constraints stdio -cleanup {
chan close $f
} -match regexp -result {^\d+$}
@@ -2041,7 +2046,7 @@ set path(output) [makeFile {} output]
test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close openpipe} -body {
+} -constraints {stdio asyncPipeChan Close} -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {
@@ -2111,7 +2116,7 @@ test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -se
test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close nonPortable openpipe} -body {
+} -constraints {stdio asyncPipeChan Close nonPortable} -body {
set f [open $path(pipe) w]
chan puts $f {
# Need to not have eof char appended on chan close, because the other
@@ -2165,7 +2170,7 @@ test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup {
} -result ok
test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
file delete $path(script)
-} -constraints {stdio unix testchannel openpipe} -body {
+} -constraints {stdio unix testchannel} -body {
set f [open $path(script) w]
chan puts $f {
chan close stdin
@@ -2382,7 +2387,7 @@ test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 "set f1 \[[list open $path(longfile) r]]"
chan puts $f1 {
@@ -2409,7 +2414,7 @@ test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts [chan gets stdin]
@@ -2462,7 +2467,7 @@ test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup {
} -match glob -result {channel "*" wasn't opened for writing}
test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} -setup {
set fd [openpipe r cat longfile]
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
chan flush $fd
} -returnCodes error -cleanup {
catch {chan close $fd}
@@ -2538,7 +2543,7 @@ test chan-io-29.20 {Implicit flush when buffer is full} -setup {
} -result {4096 12288 12600}
test chan-io-29.21 {Tcl_Flush to pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {set x [chan read stdin 6]}
chan puts $f1 {set cnt [string length $x]}
@@ -2553,7 +2558,7 @@ test chan-io-29.21 {Tcl_Flush to pipe} -setup {
} -result "read 6 characters"
test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan configure stdout -buffering full
@@ -2577,7 +2582,7 @@ test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
} -result {hello hello bye}
test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts hello
@@ -2614,7 +2619,7 @@ test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup {
} -result "{} {Line 1\nLine 2}"
test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
file delete $path(test3)
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)]
chan puts $f "Line 1"
chan puts $f "Line 2"
@@ -2625,7 +2630,7 @@ test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
} -cleanup {
chan close $f
} -result "Line 1\nLine 2\n"
-test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs openpipe} -body {
+test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs} -body {
set f [open "|[list cat -u]" r+]
chan puts $f "Line1"
chan flush $f
@@ -2638,7 +2643,7 @@ test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup {
set f [open $path(pipe) w]
chan puts $f {exit}
chan close $f
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [openpipe r+ $path(pipe)]
chan gets $f
chan puts $f output
@@ -2691,7 +2696,7 @@ test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -2724,7 +2729,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
set result ok
}
# allow a little time for the background process to chan close.
- # otherwise, the following test fails on the [file delete $path(output)
+ # otherwise, the following test fails on the [file delete $path(output)]
# on Windows because a process still has the file open.
after 100 set v 1; vwait v
return $result
@@ -2732,7 +2737,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close openpipe} -body {
+} -constraints {stdio asyncPipeChan Close} -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -4005,7 +4010,7 @@ test chan-io-32.9 {Tcl_Read, read to end of file} {
} ok
test chan-io-32.10 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
@@ -4019,7 +4024,7 @@ test chan-io-32.10 {Tcl_Read from a pipe} -setup {
test chan-io-32.11 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan puts $f1 {chan puts [chan gets stdin]}
@@ -4131,7 +4136,7 @@ test chan-io-33.2 {Tcl_Gets into variable} {
} ok
test chan-io-33.3 {Tcl_Gets from pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
@@ -4341,7 +4346,7 @@ test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position
} -result {44 rstuv 49}
test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup {
set pipe [openpipe]
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
chan seek $pipe 0 current
} -returnCodes error -cleanup {
chan close $pipe
@@ -4451,13 +4456,13 @@ test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
} -cleanup {
chan close $f1
} -result {10 20}
-test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints {stdio openpipe} -body {
+test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints stdio -body {
set f1 [openpipe]
chan tell $f1
} -cleanup {
chan close $f1
} -result -1
-test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test chan-io-34.17 {Tcl_Tell on pipe: always -1} stdio {
set f1 [openpipe]
chan puts $f1 {chan puts hello}
chan flush $f1
@@ -4559,7 +4564,7 @@ test chan-io-35.1 {Tcl_Eof} -setup {
} -cleanup {
chan close $f
} -result {0 0 0 0 1 1}
-test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+test chan-io-35.2 {Tcl_Eof with pipe} -constraints stdio -setup {
file delete $path(pipe)
} -body {
set f1 [open $path(pipe) w]
@@ -4578,7 +4583,7 @@ test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
} -cleanup {
chan close $f1
} -result {0 0 0 1}
-test chan-io-35.3 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+test chan-io-35.3 {Tcl_Eof with pipe} -constraints stdio -setup {
file delete $path(pipe)
} -body {
set f1 [open $path(pipe) w]
@@ -4616,7 +4621,7 @@ test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup {
test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup {
file delete $path(pipe)
set l ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(pipe) w]
chan puts $f {
exit
@@ -4801,7 +4806,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [openpipe]
chan puts $f1 {chan puts hello_from_pipe}
chan flush $f1
@@ -4821,7 +4826,7 @@ test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
} -result {{} 1 hello 0 {} 1}
test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup {
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [openpipe]
chan configure $f1 -buffering line
chan puts $f1 {chan puts hello_from_pipe}
@@ -5095,7 +5100,7 @@ test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup {
test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup {
file delete $path(pipe)
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan gets stdin
@@ -5192,7 +5197,7 @@ test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
chan puts -nonewline $f "\xe7"
@@ -5552,7 +5557,7 @@ test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
set result {}
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
chan event $f r "chan read f"
chan event $f2 r "chan read f2"
@@ -5572,7 +5577,7 @@ test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
test chan-io-44.1 {FileEventProc procedure: normal read event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 readable [namespace code {
set x [chan gets $f2]; chan event $f2 readable {}
}]
@@ -5592,7 +5597,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 readable {error bogus}
chan puts $f2 text; chan flush $f2
variable x initial
@@ -5606,7 +5611,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
test chan-io-44.3 {FileEventProc procedure: normal write event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5632,7 +5637,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 writable {error bad-write}
variable x initial
vwait [namespace which -variable x]
@@ -5642,7 +5647,9 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
catch {chan close $f2}
catch {chan close $f3}
} -result {bad-write {}}
-test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test chan-io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs fileevent
+} -body {
set f4 [openpipe r $path(cat) << foo]
chan event $f4 readable [namespace code {
if {[chan gets $f4 line] < 0} {
@@ -5655,9 +5662,10 @@ test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- chan close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ chan close $f4
+} -result {initial foo eof}
chan close $f
makeFile "foo bar" foo
@@ -5718,7 +5726,7 @@ test chan-io-45.3 {DeleteFileEvent, cleanup on chan close} {fileevent} {
# Execute these tests only if the "testfevent" command is present.
-test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
+test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} {
testfevent create
set script "set f \[[list open $path(foo) r]]\n"
append script {
@@ -5728,9 +5736,10 @@ test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileeven
chan event $f readable {}
}]
}
+ set timer [after 10 lappend x timeout]
testfevent cmd $script
- after 1 ;# We must delay because Windows takes a little time to notice
- update
+ vwait x
+ after cancel $timer
testfevent cmd {chan close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
@@ -5918,7 +5927,7 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
set path(my_script) [makeFile {} my_script]
test chan-io-48.3 {testing readability conditions} -setup {
set l ""
-} -constraints {stdio unix nonBlockFiles openpipe fileevent} -body {
+} -constraints {stdio unix nonBlockFiles fileevent} -body {
set f [open $path(bar) w]
chan puts $f abcdefg
chan puts $f abcdefg
@@ -6372,17 +6381,21 @@ test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
test chan-io-50.1 {testing handler deletion} -setup {
file delete $path(test1)
-} -constraints {testchannelevent} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1) r]
+ variable z not_called
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
testchannelevent $f add readable [namespace code {
variable z called
testchannelevent $f delete 0
}]
- variable z not_called
- update
- return $z
+ testservicemode 1
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
} -result called
@@ -6390,16 +6403,21 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints {testchannelevent} -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+} -constraints {testchannelevent testservicemode} -body {
proc delhandler {f i} {
variable z
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
- update
+ set z ""
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ vwait z
+ after cancel $timer
string equal $z \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
} -cleanup {
@@ -6408,11 +6426,7 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
- set z ""
-} -constraints {testchannelevent} -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+} -constraints {testchannelevent testservicemode} -body {
proc notcalled {f i} {
variable z
lappend z "notcalled was called!! $f $i"
@@ -6424,7 +6438,15 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
testchannelevent $f delete 0
lappend z "delhandler $f $i deleted myself"
}
- update
+ set z ""
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ vwait z
+ after cancel $timer
string equal $z \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
@@ -6435,7 +6457,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
if {$u eq "recursive"} {
@@ -6449,19 +6471,20 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
}]
variable u toplevel
variable z ""
- update
- return $z
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
+ update
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
+ update
+} -constraints {testchannelevent testservicemode notOSX} -body {
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6477,33 +6500,46 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
} else {
set u recursive
lappend z "del calling recursive"
- update
+ set timer [after 50 lappend z timeout]
+ set mode [test servicemode 1]
+ vwait z
+ after cancel $timer
+ test servicemode $mode
lappend z "del after update"
}
}
set z ""
set u toplevel
- update
- return $z
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
+ testservicemode 1
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
+ update
} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
+} -constraints {testchannelevent testservicemode} -body {
proc first {f} {
variable u
variable z
if {$u eq "toplevel"} {
lappend z "first called"
+ set mode [testservicemode 1]
+ set timer [after 50 lappend z timeout]
set u first
- update
+ vwait z
+ after cancel $timer
+ testservicemode $mode
lappend z "first after update"
} else {
lappend z "first called not toplevel"
@@ -6526,8 +6562,15 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
- update
- return $z
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
} -result [list {first called} {first called not toplevel} \
@@ -6709,7 +6752,7 @@ test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
test chan-io-52.8 {TclCopyChannel} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set f1 [open $path(pipe) w]
chan configure $f1 -translation lf
chan puts $f1 "
@@ -6830,7 +6873,7 @@ test chan-io-53.2 {CopyData} -setup {
test chan-io-53.3 {CopyData: background read underflow} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio unix openpipe fcopy} -body {
+} -constraints {stdio unix fcopy} -body {
set f1 [open $path(pipe) w]
chan puts -nonewline $f1 {
chan puts ready
@@ -6868,7 +6911,7 @@ test chan-io-53.4 {CopyData: background write overflow} -setup {
}
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio unix openpipe fileevent fcopy} -body {
+} -constraints {stdio unix fileevent fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts ready
@@ -6932,7 +6975,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup {
file delete $path(pipe)
file delete $path(test1)
catch {unset fcopyTestDone}
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 "exit 1"
chan close $f1
@@ -6966,7 +7009,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
variable fcopyTestDone
file delete $path(pipe)
catch {unset fcopyTestDone}
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set fcopyTestCount 0
set f1 [open $path(pipe) w]
chan puts $f1 {
@@ -7016,7 +7059,7 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Record input size, so that result is always defined
lappend ::RES [file size $bar]
# Run the copy. Should not invoke -command now.
@@ -7056,7 +7099,7 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at
# Channels to copy between
set f [open $foo r] ; chan configure $f -translation binary
set g [open $bar w] ; chan configure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Initialize and force eof on the input.
chan seek $f 0 end ; chan read $f 1
set ::RES [chan eof $f]
@@ -7114,7 +7157,7 @@ test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
}
set ::forever {}
set out [open $out w]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
chan copy $pipe $out -size 6 -command ::done
set token [after 5000 {
set ::forever {fcopy hangs}
@@ -7187,7 +7230,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
chan configure $b -translation binary -buffering none
chan event $a readable [namespace code "done $a"]
chan event $b readable [namespace code "done $b"]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
chan puts $a AB
@@ -7409,7 +7452,7 @@ test chan-io-57.2 {buffered data and file events, read} -setup {
chan close $server
} -result {1 readable 234567890 timer}
-test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
+test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
set out [open $path(script) w]
chan puts $out {
chan puts "normal message from pipe"
@@ -7447,7 +7490,7 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
string equal $result [testmainthread]
} {1}
-test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
+test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
diff --git a/tests/clock.test b/tests/clock.test
index 55607ce..c51c829 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -250,7 +250,6 @@ proc ::testClock::registry { cmd path key } {
return [dict get $reg $path $key]
}
-
# Test some of the basics of [clock format]
test clock-1.0 "clock format - wrong # args" {
@@ -35025,6 +35024,24 @@ test clock-30.8 {clock add months, negative} {
set x4 [clock format $f4 -format %Y-%m-%d -timezone :UTC]
list $x1 $x2 $x3 $x4
} {2000-02-29 2000-01-31 1999-12-31 1999-11-30}
+test clock-30.8a {clock add months, negative, over threshold of a year} {
+ set t [clock scan 2019-01-31 -format %Y-%m-%d -gmt 1]
+ list [clock format [clock add $t -1 month -gmt 1] -format %Y-%m-%d -gmt 1] \
+ [clock format [clock add $t -2 month -gmt 1] -format %Y-%m-%d -gmt 1] \
+ [clock format [clock add $t -3 month -gmt 1] -format %Y-%m-%d -gmt 1] \
+ [clock format [clock add $t -4 month -gmt 1] -format %Y-%m-%d -gmt 1]
+} {2018-12-31 2018-11-30 2018-10-31 2018-09-30}
+test clock-30.8b {clock add months, negative, over threshold of a year} {
+ set t [clock scan 2000-01-28 -format %Y-%m-%d -gmt 1]
+ for {set i 1} {$i < 24} {incr i 1} {
+ set f1 [clock add $t -$i month -gmt 1]
+ set f2 [clock add $f1 $i month -gmt 1]
+ if {$f2 != $t} {
+ error "\[clock add $t -$i month -gmt 1\] does not consider\
+ \[clock add $f1 $i month -gmt 1\] != $t"
+ }
+ }
+} {}
test clock-30.9 {clock add days} {
set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \
-timezone :UTC]
@@ -35613,7 +35630,6 @@ test clock-34.11 {clock scan tests} {
set time [clock scan "1/1/37" -gmt true]
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,2037 00:00 GMT}
-
test clock-34.12 {clock scan, relative times} {
set time [clock scan "Oct 23, 1992 -1 day"]
clock format $time -format {%b %d, %Y}
@@ -35765,7 +35781,6 @@ test clock-34.43 {last monday in november} {
}
set res
} {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25}
-
test clock-34.44 {2nd monday in november} {
set res {}
foreach i {91 92 93 94 95 96} {
@@ -35798,38 +35813,95 @@ test clock-34.47 {ago with multiple relative units} {
set res [clock scan "2 days 2 hours ago" -base $base]
expr {$base - $res}
} 180000
-
test clock-34.48 {more than one ToD} {*}{
-body {clock scan {10:00 11:00}}
-returnCodes error
-result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
}
-
test clock-34.49 {more than one date} {*}{
-body {clock scan {1/1/2001 2/2/2002}}
-returnCodes error
-result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
}
-
test clock-34.50 {more than one time zone} {*}{
-body {clock scan {10:00 EST CST}}
-returnCodes error
-result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
}
-
test clock-34.51 {more than one weekday} {*}{
-body {clock scan {Monday Tuesday}}
-returnCodes error
-result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
}
-
test clock-34.52 {more than one ordinal month} {*}{
-body {clock scan {next January next March}}
-returnCodes error
-result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}
-
-
+test clock-34.53 {clock scan, ISO 8601 point in time format} {
+ set time [clock scan "19921023T00:00:00"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} "Oct 23, 1992 00:00:00"
+test clock-34.54 {clock scan, ISO 8601 point in time format} {
+ set time [clock scan "1992-10-23T00:00:00"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} "Oct 23, 1992 00:00:00"
+test clock-34.55 {clock scan, ISO 8601 invalid TZ} -body {
+ set time [clock scan "19921023MST000000"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} -returnCodes error -match glob -result {unable to convert date-time string*}
+test clock-34.56 {clock scan, ISO 8601 invalid TZ} -body {
+ set time [clock scan "19921023M000000"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} -returnCodes error -match glob -result {unable to convert date-time string*}
+test clock-34.57 {clock scan, ISO 8601 invalid TZ} -body {
+ set time [clock scan "1992-10-23M00:00:00"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} -returnCodes error -match glob -result {unable to convert date-time string*}
+test clock-34.58 {clock scan, ISO 8601 invalid TZ} -body {
+ set time [clock scan "1992-10-23MST00:00:00"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} -returnCodes error -match glob -result {unable to convert date-time string*}
+test clock-34.59 {clock scan tests (-TZ)} {
+ set time [clock scan "31 Jan 14 23:59:59 -0100"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Feb 01,2014 00:59:59 GMT}
+test clock-34.60 {clock scan tests (+TZ)} {
+ set time [clock scan "31 Jan 14 23:59:59 +0100"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 31,2014 22:59:59 GMT}
+test clock-34.61 {clock scan tests (-TZ)} {
+ set time [clock scan "23:59:59 -0100" -base 0 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 02,1970 00:59:59 GMT}
+test clock-34.62 {clock scan tests (+TZ)} {
+ set time [clock scan "23:59:59 +0100" -base 0 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 01,1970 22:59:59 GMT}
+test clock-34.63 {clock scan tests (TZ)} {
+ set time [clock scan "Mon, 30 Jun 2014 23:59:59 CEST"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jun 30,2014 21:59:59 GMT}
+test clock-34.64 {clock scan tests (TZ)} {
+ set time [clock scan "Fri, 31 Jan 2014 23:59:59 CET"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 31,2014 22:59:59 GMT}
+test clock-34.65 {clock scan tests (relspec, day unit not TZ)} {
+ set time [clock scan "23:59:59 +15 day" -base 2000000 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Feb 08,1970 23:59:59 GMT}
+test clock-34.66 {clock scan tests (relspec, day unit not TZ)} {
+ set time [clock scan "23:59:59 -15 day" -base 2000000 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 09,1970 23:59:59 GMT}
+test clock-34.67 {clock scan tests (merid and TZ)} {
+ set time [clock scan "10:59 pm CET" -base 2000000 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 24,1970 21:59:00 GMT}
+test clock-34.68 {clock scan tests (merid and TZ)} {
+ set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 24,1970 21:59:00 GMT}
# clock seconds
test clock-35.1 {clock seconds tests} {
@@ -36929,12 +37001,10 @@ test clock-67.2 {Bug d19a30db57} -body {
# error, not segfault
tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
} -returnCodes error -match glob -result *
-
test clock-67.3 {Bug d19a30db57} -body {
# error, not segfault
tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
} -returnCodes error -match glob -result *
-
test clock-67.4 {Change format %x output on global locale change [Bug 4a0c163d24]} -setup {
package require msgcat
set current [msgcat::mclocale]
@@ -36946,7 +37016,6 @@ test clock-67.4 {Change format %x output on global locale change [Bug 4a0c163d24
} -cleanup {
msgcat::mclocale $current
} -result {1 1}
-
test clock-67.5 {Change scan %x output on global locale change [Bug 4a0c163d24]} -setup {
package require msgcat
set current [msgcat::mclocale]
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 992a8f4..cc167a0 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -1638,7 +1638,7 @@ test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
lsort [safeInterp eval [list file channels]]
} [lsort [list stdout $newFileId]]
test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
- # we can now write to $newFileId from slave
+ # we can now write to $newFileId from child
safeInterp eval [list puts $newFileId "hello"]
} {}
interp transfer {} $newFileId safeInterp
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index fe72d94..68f7892 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,11 +8,12 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
+
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index 0a587e8..e690002 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -13,8 +13,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 43b3703..0675a5d 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -11,9 +11,9 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[catch {package require tcltest 2.1}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
namespace eval ::tcl::test::cmdMZ {
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index e57f799..f573cfa 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -12,11 +12,12 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
+
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/compExpr.test b/tests/compExpr.test
index 3b44af8..e9220c1 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -9,7 +9,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -341,9 +341,9 @@ test compExpr-7.1 {Memory Leak} -constraints memory -setup {
} -body {
set end [getbytes]
for {set i 0} {$i < 5} {incr i} {
- interp create slave
- slave eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
- interp delete slave
+ interp create child
+ child eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
+ interp delete child
set tmp $end
set end [getbytes]
}
diff --git a/tests/compile.test b/tests/compile.test
index 18e978f..b90f124 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -11,8 +11,11 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
+
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/concat.test b/tests/concat.test
index eeb11ca..8ff5500 100644
--- a/tests/concat.test
+++ b/tests/concat.test
@@ -12,7 +12,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/config.test b/tests/config.test
index 468a1df..b78e29d 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 86a5481..6d79fd7 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -771,25 +771,25 @@ test coroutine-8.0.1 {coro inject after error} -body {
lappend ::result [catch {demo} err] $err
} -result {inject-executed 1 test}
test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body {
- interp create slave
- slave eval {
+ interp create child
+ child eval {
coroutine demo apply {{} { while {1} yield }}
demo
tcl::unsupported::inject demo set ::result inject-executed
}
- interp delete slave
+ interp delete child
} -result {}
test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body {
- interp create slave
- slave eval {
+ interp create child
+ child eval {
coroutine demo apply {{} { while {1} yield }}
demo
tcl::unsupported::inject demo set ::result inject-executed
}
- slave eval demo
- set result [slave eval {set ::result}]
+ child eval demo
+ set result [child eval {set ::result}]
- interp delete slave
+ interp delete child
set result
} -result {inject-executed}
diff --git a/tests/dcall.test b/tests/dcall.test
index 41dd777..7d86135 100644
--- a/tests/dcall.test
+++ b/tests/dcall.test
@@ -11,8 +11,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/dict.test b/tests/dict.test
index e5284fc..01e4bde 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/dstring.test b/tests/dstring.test
index 5feb355..8a24ebe 100644
--- a/tests/dstring.test
+++ b/tests/dstring.test
@@ -12,7 +12,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/encoding.test b/tests/encoding.test
index ccc32da..d0ca114 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -8,13 +8,15 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
+
namespace eval ::tcl::test::encoding {
variable x
-namespace import -force ::tcltest::*
-
catch {
::tcltest::loadTestedCommands
package require -exact Tcltest [info patchlevel]
@@ -292,7 +294,7 @@ test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
append x [encoding convertfrom iso8859-3 ab\xD5g]
} "ab\xd5gab\u120g"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
- set x [encoding convertto shiftjis ab\u4E4Eg]
+ set x [encoding convertto shiftjis ab\u4E4Eg]
append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
@@ -391,7 +393,12 @@ test encoding-15.15 {UtfToUtfProc low surrogate character output} {
binary scan $y H* z
list [string length $x] [string length $y] $z
} {1 3 eda882}
-test encoding-15.16 {UtfToUtfProc emoji character output} {
+test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
+ set x \xF0\xA0\xA1\xC2
+ set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2]
+ list [string length $x] $y
+} "4 \xF0\xA0\xA1\xC2"
+test encoding-15.17 {UtfToUtfProc emoji character output} {
set x \U1F602
set y [encoding convertto utf-8 \U1F602]
binary scan $y H* z
diff --git a/tests/env.test b/tests/env.test
index 4af46c3..bad9e66 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -326,11 +326,11 @@ test env-5.2 {corner cases - unset the env array} -setup {
} -result {0}
-test env-5.3 {corner cases: unset the env in master should unset child} -setup {
+test env-5.3 {corner cases: unset the env in parent should unset child} -setup {
setup1
interp create i
} -body {
- # Variables deleted in a master interp should be deleted in child interp
+ # Variables deleted in a parent interp should be deleted in child interp
# too.
i eval {set env(THIS_SHOULD_EXIST) a}
set result [set env(THIS_SHOULD_EXIST)]
diff --git a/tests/error.test b/tests/error.test
index af07ed7..a111c80 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/eval.test b/tests/eval.test
index 70ceac8..d473fdf 100644
--- a/tests/eval.test
+++ b/tests/eval.test
@@ -12,7 +12,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/event.test b/tests/event.test
index 5c111f8..3194547 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
+package require tcltest 2.5
namespace import -force ::tcltest::*
catch {
@@ -23,16 +23,18 @@ testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
testConstraint exec [llength [info commands exec]]
-
+testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
+
test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler close
set result ""
-} -constraints {testfilehandler} -body {
+} -constraints {testfilehandler notOSX} -body {
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
+ update idletasks
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
diff --git a/tests/exec.test b/tests/exec.test
index 36aeae5..5082393 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -14,8 +14,10 @@
# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/execute.test b/tests/execute.test
index fbc4f99..6d27e55 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -15,7 +15,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -657,56 +657,56 @@ test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -se
namespace delete foo
} -result {0 AHA!}
test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup {
- interp create slave
+ interp create child
} -body {
set script { llength {} }
- slave eval {proc llength args {return AHA!}}
+ child eval {proc llength args {return AHA!}}
set result {}
lappend result [if 1 $script]
- lappend result [slave eval $script]
+ lappend result [child eval $script]
} -cleanup {
- interp delete slave
+ interp delete child
} -result {0 AHA!}
test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body {
set script { llength {} }
- interp create slave
+ interp create child
set result {}
- lappend result [slave eval $script]
- interp delete slave
- interp create slave
- lappend result [slave eval $script]
+ lappend result [child eval $script]
+ interp delete child
+ interp create child
+ lappend result [child eval $script]
} -cleanup {
- catch {interp delete slave}
+ catch {interp delete child}
} -result {0 0}
test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
- interp create slave
+ interp create child
} -constraints testexprlongobj -body {
set e { [llength {}]+1 }
set result {}
- load {} Tcltest slave
- interp alias {} e slave testexprlongobj
+ load {} Tcltest child
+ interp alias {} e child testexprlongobj
lappend result [e $e]
- interp delete slave
- interp create slave
- load {} Tcltest slave
- interp alias {} e slave testexprlongobj
+ interp delete child
+ interp create child
+ load {} Tcltest child
+ interp alias {} e child testexprlongobj
lappend result [e $e]
} -cleanup {
- interp delete slave
+ interp delete child
} -result {{This is a result: 1} {This is a result: 1}}
test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
- interp create slave
+ interp create child
} -body {
set e { [llength {}]+1 }
set result {}
- interp alias {} e slave expr
+ interp alias {} e child expr
lappend result [e $e]
- interp delete slave
- interp create slave
- interp alias {} e slave expr
+ interp delete child
+ interp create child
+ interp alias {} e child expr
lappend result [e $e]
} -cleanup {
- interp delete slave
+ interp delete child
} -result {1 1}
test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
set e { [llength {}]+1 }
@@ -747,16 +747,16 @@ test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setu
namespace delete foo
} -result {1 2}
test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup {
- interp create slave
+ interp create child
} -body {
set e { [llength {}]+1 }
- interp alias {} e slave expr
- slave eval {proc llength args {return 1}}
+ interp alias {} e child expr
+ child eval {proc llength args {return 1}}
set result {}
lappend result [expr $e]
lappend result [e $e]
} -cleanup {
- interp delete slave
+ interp delete child
} -result {1 2}
test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body {
proc foo e {set v 0; expr $e}
@@ -982,9 +982,9 @@ test execute-8.5 {Bug 2038069} -setup {
"catch \[list error FOO\] m o"} -errorline 2}
test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup {
- interp create slave
- slave eval {
- package require tcltest
+ interp create child
+ child eval {
+ package require tcltest 2.5
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands
if {[namespace which -command testbumpinterpepoch] eq ""} {
@@ -992,32 +992,32 @@ test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup
}
}
} -body {
- slave eval {
+ child eval {
lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C;
}
- slave eval {
+ child eval {
set i 0; while {[incr i] < 3} {
lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C;
}
}
- slave eval {
+ child eval {
set i 0; while {[incr i] < 3} {
lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C;
}
}
- slave eval {
+ child eval {
catch {
lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C;
}
}
- slave eval {set res}
+ child eval {set res}
} -cleanup {
- interp delete slave
+ interp delete child
} -result [lrepeat 4 A B]
test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup {
- interp create slave
- slave eval {
- package require tcltest
+ interp create child
+ child eval {
+ package require tcltest 2.5
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands
if {[namespace which -command testbumpinterpepoch] eq ""} {
@@ -1027,28 +1027,28 @@ test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), excepti
} -body {
set res {}
lappend res [catch {
- slave eval {
+ child eval {
lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C;
}
} e] $e
lappend res [catch {
- slave eval {
+ child eval {
lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C;
}
} e] $e
lappend res [catch {
- slave eval {
+ child eval {
lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C;
}
} e] $e
lappend res [catch {
- slave eval {
+ child eval {
lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C;
}
} e] $e
- list $res [slave eval {set res}]
+ list $res [child eval {set res}]
} -cleanup {
- interp delete slave
+ interp delete child
} -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]]
test execute-9.1 {Interp result resetting [Bug 1522803]} {
@@ -1069,16 +1069,16 @@ test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130
} {48 {304 304}}
test execute-10.2 {Bug 2802881} -setup {
- interp create slave
+ interp create child
} -body {
# If [Bug 2802881] is not fixed, this will segfault
- slave eval {
+ child eval {
trace add variable ::errorInfo write {expr {$foo} ;#}
proc demo {} {a {}{}}
demo
}
} -cleanup {
- interp delete slave
+ interp delete child
} -returnCodes error -match glob -result *
test execute-10.3 {Bug 3072640} -setup {
proc generate {n} {
@@ -1103,9 +1103,9 @@ test execute-10.3 {Bug 3072640} -setup {
} -result 4
test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
set x [lrepeat 1320 199]
for {set i 0} {$i < 20} {incr i} {
lappend x $i
@@ -1115,7 +1115,7 @@ test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
return ok
}
} -cleanup {
- interp delete slave
+ interp delete child
} -result ok
test execute-11.2 {Bug 268b23df11} -setup {
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 003ee00..ad5a6bc 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,8 +13,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2.1
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/expr.test b/tests/expr.test
index f0b75f4..0b4fa2b 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2.1
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index e8ed6f9..53313dc 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/fileName.test b/tests/fileName.test
index 0e4cb9e..d4dfd9a 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -11,10 +11,11 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
+
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 361542d..19066ee 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -9,9 +9,12 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
namespace eval ::tcl::test::fileSystem {
- namespace import ::tcltest::*
+
+ if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+ }
catch {
file delete -force link.file
diff --git a/tests/fileSystemEncoding.test b/tests/fileSystemEncoding.test
index 0f8a2a7..6561bef 100644
--- a/tests/fileSystemEncoding.test
+++ b/tests/fileSystemEncoding.test
@@ -7,8 +7,11 @@ if {[string equal $::tcl_platform(os) "Windows NT"]} {
}
namespace eval ::tcl::test::fileSystemEncoding {
- package require tcltest 2
- namespace import ::tcltest::*
+
+ if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+ }
variable fname1 \u767b\u9e1b\u9d72\u6a13
diff --git a/tests/for-old.test b/tests/for-old.test
index a11a791..d00a4ee 100644
--- a/tests/for-old.test
+++ b/tests/for-old.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/for.test b/tests/for.test
index c8a8187..239e4d6 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/foreach.test b/tests/foreach.test
index 84af4bd..cdbfc85 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/format.test b/tests/format.test
index 3640376..8d6fd82 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/get.test b/tests/get.test
index e35b2cc..9e7728a 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -109,6 +109,12 @@ test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
set x
}
} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
+test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint {
+ lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " " 0_07 " " 0o_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } {
+ catch {testgetint $x} x
+ set x
+ }
+} {0 10 2 33 1423324 10 7 8 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/history.test b/tests/history.test
index 9ff41f2..922d984 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -12,7 +12,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/http.test b/tests/http.test
index 8eac3c3..7454ab8 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -11,15 +11,17 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
if {[catch {package require http 2} version]} {
if {[info exists http2]} {
catch {puts "Cannot load http 2.* package"}
return
} else {
- catch {puts "Running http 2.* tests in slave interp"}
+ catch {puts "Running http 2.* tests in child interp"}
set interp [interp create http2]
$interp eval [list set http2 "running"]
$interp eval [list set argv $argv]
diff --git a/tests/http11.test b/tests/http11.test
index 1e30802..f243e56 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -7,17 +7,19 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
-package require http 2.8
+package require http 2.9
# start the server
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
}
@@ -60,6 +62,20 @@ proc meta {tok {key ""}} {
return $meta
}
+proc state {tok {key ""}} {
+ upvar 1 $tok state
+ if {$key ne ""} {
+ if {[array names state -exact $key] ne {}} {
+ return $state($key)
+ } else {
+ return ""
+ }
+ }
+ set res [array get state]
+ dict set res body <elided>
+ return $res
+}
+
proc check_crc {tok args} {
set crc [meta $tok x-crc32]
set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
@@ -241,8 +257,45 @@ test http11-1.12 "normal,identity,chunked" -setup {
halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
+test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup {
+ variable httpd [create_httpd]
+ set zipTmp [http::config -zip]
+ http::config -zip 0
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
+ -protocol 1.1 -keepalive 1 -timeout 10000]
+ http::wait $tok
+ set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]]
+ set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
+ -protocol 1.1 -keepalive 1 -timeout 10000]
+ http::wait $toj
+ set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \
+ [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]]
+ concat $res1 -- $res2
+} -cleanup {
+ http::cleanup $tok
+ http::cleanup $toj
+ halt_httpd
+ http::config -zip $zipTmp
+} -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive}
+
# -------------------------------------------------------------------------
+proc progress {var token total current} {
+ upvar #0 $var log
+ set log [list $current $total]
+ return
+}
+
+proc progressPause {var token total current} {
+ upvar #0 $var log
+ set log [list $current $total]
+ after 100 set ::WaitHere 0
+ vwait ::WaitHere
+ return
+}
+
test http11-2.0 "-channel" -setup {
variable httpd [create_httpd]
set chan [open [makeFile {} testfile.tmp] wb+]
@@ -339,6 +392,58 @@ test http11-2.4 "-channel,encoding identity" -setup {
halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
+test http11-2.4.1 "-channel,encoding identity with -progress" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+ set logdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan \
+ -headers {accept-encoding identity} \
+ -progress [namespace code [list progress logdata]]]
+
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding] \
+ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
+ [expr {[lindex $logdata 0] - [string length $data]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+ unset -nocomplain logdata data
+} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}
+
+test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+ set logdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan \
+ -headers {accept-encoding identity} \
+ -progress [namespace code [list progressPause logdata]]]
+
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding] \
+ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
+ [expr {[lindex $logdata 0] - [string length $data]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+ unset -nocomplain logdata data ::WaitHere
+} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}
+
test http11-2.5 "-channel,encoding unsupported" -setup {
variable httpd [create_httpd]
set chan [open [makeFile {} testfile.tmp] wb+]
@@ -518,6 +623,16 @@ proc handler {var sock token} {
return [string length $chunk]
}
+proc handlerPause {var sock token} {
+ upvar #0 $var data
+ set chunk [read $sock]
+ append data $chunk
+ #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
+ after 100 set ::WaitHere 0
+ vwait ::WaitHere
+ return [string length $chunk]
+}
+
test http11-3.0 "-handler,close,identity" -setup {
variable httpd [create_httpd]
set testdata ""
@@ -589,6 +704,135 @@ test http11-3.3 "-handler,keepalive,chunked" -setup {
halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+# http11-3.4
+# This test is a blatant attempt to confuse the client by instructing the server
+# to send neither "Connection: close" nor "Content-Length" when in non-chunked
+# mode.
+# The client has no way to know the response-body is complete unless the
+# server signals this by closing the connection.
+# In an HTTP/1.1 response the absence of "Connection: close" means
+# "Connection: keep-alive", i.e. the server will keep the connection
+# open. In HTTP/1.0 this is not the case, and this is a test that
+# the Tcl client assumes "Connection: close" by default in HTTP/1.0.
+test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \
+ -timeout 10000 -handler [namespace code [list handler testdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0}
+
+# It is not forbidden for a handler to enter the event loop.
+test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -handler [namespace code [list handlerPause testdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata ::WaitHere
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+ set logdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -handler [namespace code [list handler testdata]] \
+ -progress [namespace code [list progress logdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}] \
+ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
+ [expr {[lindex $logdata 0] - [string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata logdata ::WaitHere
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}
+
+test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+ set logdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -handler [namespace code [list handler testdata]] \
+ -progress [namespace code [list progressPause logdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}] \
+ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
+ [expr {[lindex $logdata 0] - [string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata logdata ::WaitHere
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}
+
+test http11-3.8 "close,identity no -handler but with -progress" -setup {
+ variable httpd [create_httpd]
+ set logdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 \
+ -progress [namespace code [list progress logdata]] \
+ -headers {accept-encoding {}}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
+ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
+ [expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain logdata ::WaitHere
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}
+
+test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup {
+ variable httpd [create_httpd]
+ set logdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 \
+ -progress [namespace code [list progressPause logdata]] \
+ -headers {accept-encoding {}}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
+ [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
+ [expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain logdata ::WaitHere
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}
+
test http11-4.0 "normal post request" -setup {
variable httpd [create_httpd]
} -body {
diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
index 8de79b9..4306149 100644
--- a/tests/httpPipeline.test
+++ b/tests/httpPipeline.test
@@ -8,10 +8,12 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
-package require http 2.8
+package require http 2.9
set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
diff --git a/tests/httpTest.tcl b/tests/httpTest.tcl
index 4345845..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]]
@@ -153,7 +153,7 @@ proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
set myStart [lsearch -exact $someResults [list B $i]]
set myEnd [lsearch -exact $someResults [list $term $i]]
- if {($myStart == -1 || $myEnd == -1)} {
+ if {($myStart < 0 || $myEnd < 0)} {
set res "Cannot find positions of transaction $i"
append msg $res \n
Puts $res
@@ -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/httpcookie.test b/tests/httpcookie.test
index b3c5412..ca54073 100644
--- a/tests/httpcookie.test
+++ b/tests/httpcookie.test
@@ -9,8 +9,10 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
index 7880494..89590ec 100644
--- a/tests/httpd11.tcl
+++ b/tests/httpd11.tcl
@@ -170,14 +170,19 @@ proc Service {chan addr port} {
set close 1
}
+ set nosendclose 0
foreach pair [split $query &] {
if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""}
switch -exact -- $key {
+ nosendclose {set nosendclose 1}
close {set close 1 ; set transfer 0}
transfer {set transfer $val}
content-type {set type $val}
}
}
+ if {$protocol eq "HTTP/1.1"} {
+ set nosendclose 0
+ }
chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
Puts $chan "$protocol $code"
@@ -186,12 +191,16 @@ proc Service {chan addr port} {
if {$req eq "POST"} {
Puts $chan [format "x-query-length: %d" [string length $query]]
}
- if {$close} {
+ if {$close && (!$nosendclose)} {
Puts $chan "connection: close"
}
Puts $chan "x-requested-encodings: [dict get? $meta accept-encoding]"
- if {$encoding eq "identity"} {
+ if {$encoding eq "identity" && (!$nosendclose)} {
Puts $chan "content-length: [string length $data]"
+ } elseif {$encoding eq "identity"} {
+ # This is a blatant attempt to confuse the client by sending neither
+ # "Connection: close" nor "Content-Length" when in non-chunked mode.
+ # See test http11-3.4.
} else {
Puts $chan "content-encoding: $encoding"
}
@@ -228,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/if-old.test b/tests/if-old.test
index fbcf56c..e537fea 100644
--- a/tests/if-old.test
+++ b/tests/if-old.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/if.test b/tests/if.test
index 040364a..f5acf60 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/incr-old.test b/tests/incr-old.test
index ed457cf..5d792e1 100644
--- a/tests/incr-old.test
+++ b/tests/incr-old.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/incr.test b/tests/incr.test
index aa2872a..9d92f85 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 126d062..079eb52 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -8,8 +8,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/info.test b/tests/info.test
index ce51523..813b418 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -16,7 +16,7 @@
# DO NOT DELETE THIS LINE
if {{::tcltest} ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
@@ -2447,16 +2447,16 @@ test info-40.9 {info cmdtype: imports} -setup {
rename ::testinfocmdtype::bar {}
namespace delete ::testinfocmdtype::foo
} -result import
-test info-40.10 {info cmdtype: slaves} -setup {
+test info-40.10 {info cmdtype: interps} -setup {
apply {i {
- rename $i ::testinfocmdtype::slave
- variable ::testinfocmdtype::slave $i
+ rename $i ::testinfocmdtype::child
+ variable ::testinfocmdtype::child $i
}} [interp create]
} -body {
- info cmdtype ::testinfocmdtype::slave
+ info cmdtype ::testinfocmdtype::child
} -cleanup {
- interp delete $::testinfocmdtype::slave
-} -result slave
+ interp delete $::testinfocmdtype::child
+} -result interp
test info-40.11 {info cmdtype: objects} -setup {
apply {{} {
oo::object create obj
@@ -2518,7 +2518,7 @@ test info-40.16 {info cmdtype: dynamic behavior} -setup {
catch {rename bar {}}
}
} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
-test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
+test info-40.17 {info cmdtype: aliases in child interpreters} -setup {
set i [interp create]
} -body {
$i alias foo gorp
@@ -2528,7 +2528,7 @@ test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
} -cleanup {
interp delete $i
} -result alias
-test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
+test info-40.18 {info cmdtype: aliases in child interpreters} -setup {
set safe [interp create -safe]
} -body {
$safe alias foo gorp
@@ -2538,7 +2538,7 @@ test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
} -returnCodes error -cleanup {
interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
-test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
+test info-40.19 {info cmdtype: aliases in child interpreters} -setup {
set safe [interp create -safe]
} -body {
set inner [interp create [list $safe bar]]
@@ -2551,7 +2551,7 @@ test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
} -returnCodes error -cleanup {
interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
-test info-40.20 {info cmdtype: aliases in slave interpreters} -setup {
+test info-40.20 {info cmdtype: aliases in child interpreters} -setup {
set safe [interp create -safe]
} -body {
$safe eval {
diff --git a/tests/init.test b/tests/init.test
index a241c0b..a607ff0 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.3.4
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -19,16 +19,16 @@ if {"::tcltest" ni [namespace children]} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
test init-0.1 {no error on initialization phase (init.tcl)} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
list [set v [info exists ::errorInfo]] \
[if {$v} {set ::errorInfo}] \
[set v [info exists ::errorCode]] \
[if {$v} {set ::errorCode}]
}
} -cleanup {
- interp delete slave
+ interp delete child
} -result {0 {} 0 {}}
# Six cases - white box testing
@@ -59,11 +59,11 @@ test init-1.8 {auto_qualify - multiple colons 2} {
auto_qualify :::foo ::bar
} foo
-# We use a sub-interp and auto_reset and double the tests because there is 2
+# We use a child interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
+tcltest::loadIntoChildInterpreter $testInterp {*}$argv
interp eval $testInterp {
namespace import -force ::tcltest::*
customMatch pairwise {apply {{mode pair} {
diff --git a/tests/interp.test b/tests/interp.test
index 599ac08..4453d90 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -11,7 +11,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -22,7 +22,7 @@ testConstraint testinterpdelete [llength [info commands testinterpdelete]]
set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
-foreach i [interp slaves] {
+foreach i [interp children] {
interp delete $i
}
@@ -32,7 +32,7 @@ test interp-1.1 {options for interp command} -returnCodes error -body {
} -result {wrong # args: should be "interp cmd ?arg ...?"}
test interp-1.2 {options for interp command} -returnCodes error -body {
interp frobox
-} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -46,17 +46,17 @@ test interp-1.5 {options for interp command} -returnCodes error -body {
# test interp-0.6 was removed
#
test interp-1.6 {options for interp command} -returnCodes error -body {
- interp slaves foo bar zop
-} -result {wrong # args: should be "interp slaves ?path?"}
+ interp children foo bar zop
+} -result {wrong # args: should be "interp children ?path?"}
test interp-1.7 {options for interp command} -returnCodes error -body {
interp hello
-} -result {bad option "hello": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
interp -froboz
-} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
interp -froboz -safe
-} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.10 {options for interp command} -returnCodes error -body {
interp target
} -result {wrong # args: should be "interp target path alias"}
@@ -120,45 +120,45 @@ test interp-2.13 {correct default when no $path arg is given} -body {
interp create --
} -match regexp -result {interp[0-9]+}
-foreach i [interp slaves] {
+foreach i [interp children] {
interp delete $i
}
-# Part 2: Testing "interp slaves" and "interp exists"
-test interp-3.1 {testing interp exists and interp slaves} {
- interp slaves
+# Part 2: Testing "interp children" and "interp exists"
+test interp-3.1 {testing interp exists and interp children} {
+ interp children
} ""
-test interp-3.2 {testing interp exists and interp slaves} {
+test interp-3.2 {testing interp exists and interp children} {
interp create a
interp exists a
} 1
-test interp-3.3 {testing interp exists and interp slaves} {
+test interp-3.3 {testing interp exists and interp children} {
interp exists nonexistent
} 0
-test interp-3.4 {testing interp exists and interp slaves} -body {
- interp slaves a b c
-} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
-test interp-3.5 {testing interp exists and interp slaves} -body {
+test interp-3.4 {testing interp exists and interp children} -body {
+ interp children a b c
+} -returnCodes error -result {wrong # args: should be "interp children ?path?"}
+test interp-3.5 {testing interp exists and interp children} -body {
interp exists a b c
} -returnCodes error -result {wrong # args: should be "interp exists ?path?"}
-test interp-3.6 {testing interp exists and interp slaves} {
+test interp-3.6 {testing interp exists and interp children} {
interp exists
} 1
-test interp-3.7 {testing interp exists and interp slaves} -setup {
+test interp-3.7 {testing interp exists and interp children} -setup {
catch {interp create a}
} -body {
- interp slaves
+ interp children
} -result a
-test interp-3.8 {testing interp exists and interp slaves} -body {
- interp slaves a b c
-} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
-test interp-3.9 {testing interp exists and interp slaves} -setup {
+test interp-3.8 {testing interp exists and interp children} -body {
+ interp children a b c
+} -returnCodes error -result {wrong # args: should be "interp children ?path?"}
+test interp-3.9 {testing interp exists and interp children} -setup {
catch {interp create a}
} -body {
interp create {a a2} -safe
- expr {"a2" in [interp slaves a]}
+ expr {"a2" in [interp children a]}
} -result 1
-test interp-3.10 {testing interp exists and interp slaves} -setup {
+test interp-3.10 {testing interp exists and interp children} -setup {
catch {interp create a}
catch {interp create {a a2}}
} -body {
@@ -186,7 +186,7 @@ test interp-4.5 {testing interp delete} {
interp create a
interp create {a x1}
interp delete {a x1}
- expr {"x1" in [interp slaves a]}
+ expr {"x1" in [interp children a]}
} 0
test interp-4.6 {testing interp delete} {
interp create c1
@@ -203,14 +203,14 @@ test interp-4.8 {testing interp delete} -returnCodes error -body {
interp delete {}
} -result {cannot delete the current interpreter}
-foreach i [interp slaves] {
+foreach i [interp children] {
interp delete $i
}
# Part 4: Consistency checking - all nondeleted interpreters should be
# there:
test interp-5.1 {testing consistency} {
- interp slaves
+ interp children
} ""
test interp-5.2 {testing consistency} {
interp exists a
@@ -247,27 +247,27 @@ test interp-6.6 {testing eval} -returnCodes error -body {
interp eval {a x2} foo
} -result {invalid command name "foo"}
-# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
-proc in_master {args} {
- return [list seen in master: $args]
+# UTILITY PROCEDURE RUNNING IN PARENT INTERPRETER:
+proc in_parent {args} {
+ return [list seen in parent: $args]
}
# Part 6: Testing basic alias creation
test interp-7.1 {testing basic alias creation} {
- a alias foo in_master
+ a alias foo in_parent
} foo
-catch {a alias foo in_master}
+catch {a alias foo in_parent}
test interp-7.2 {testing basic alias creation} {
- a alias bar in_master a1 a2 a3
+ a alias bar in_parent a1 a2 a3
} bar
-catch {a alias bar in_master a1 a2 a3}
+catch {a alias bar in_parent a1 a2 a3}
# Test 6.3 has been deleted.
test interp-7.3 {testing basic alias creation} {
a alias foo
-} in_master
+} in_parent
test interp-7.4 {testing basic alias creation} {
a alias bar
-} {in_master a1 a2 a3}
+} {in_parent a1 a2 a3}
test interp-7.5 {testing basic alias creation} {
lsort [a aliases]
} {bar foo}
@@ -278,14 +278,14 @@ test interp-7.6 {testing basic aliases arg checking} -returnCodes error -body {
# Part 7: testing basic alias invocation
test interp-8.1 {testing basic alias invocation} {
catch {interp create a}
- a alias foo in_master
+ a alias foo in_parent
a eval foo s1 s2 s3
-} {seen in master: {s1 s2 s3}}
+} {seen in parent: {s1 s2 s3}}
test interp-8.2 {testing basic alias invocation} {
catch {interp create a}
- a alias bar in_master a1 a2 a3
+ a alias bar in_parent a1 a2 a3
a eval bar s1 s2 s3
-} {seen in master: {a1 a2 a3 s1 s2 s3}}
+} {seen in parent: {a1 a2 a3 s1 s2 s3}}
test interp-8.3 {testing basic alias invocation} -returnCodes error -body {
catch {interp create a}
a alias
@@ -294,13 +294,13 @@ test interp-8.3 {testing basic alias invocation} -returnCodes error -body {
# Part 8: Testing aliases for non-existent or hidden targets
test interp-9.1 {testing aliases for non-existent targets} {
catch {interp create a}
- a alias zop nonexistent-command-in-master
+ a alias zop nonexistent-command-in-parent
list [catch {a eval zop} msg] $msg
-} {1 {invalid command name "nonexistent-command-in-master"}}
+} {1 {invalid command name "nonexistent-command-in-parent"}}
test interp-9.2 {testing aliases for non-existent targets} {
catch {interp create a}
- a alias zop nonexistent-command-in-master
- proc nonexistent-command-in-master {} {return i_exist!}
+ a alias zop nonexistent-command-in-parent
+ proc nonexistent-command-in-parent {} {return i_exist!}
a eval zop
} i_exist!
test interp-9.3 {testing aliases for hidden commands} {
@@ -329,8 +329,8 @@ test interp-9.4 {testing aliases and namespace commands} {
set res
} {GLOBAL GLOBAL}
-if {[info command nonexistent-command-in-master] != ""} {
- rename nonexistent-command-in-master {}
+if {[info command nonexistent-command-in-parent] != ""} {
+ rename nonexistent-command-in-parent {}
}
# Part 9: Aliasing between interpreters
@@ -380,9 +380,9 @@ test interp-10.6 {testing aliasing between interpreters} {
interp create a
interp create b
interp alias a a_command b b_command a1 a2 a3
- b alias b_command in_master b1 b2 b3
+ b alias b_command in_parent b1 b2 b3
a eval a_command m1 m2 m3
-} {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
+} {seen in parent: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
test interp-10.7 {testing aliases between interpreters} {
catch {interp delete a}
interp create a
@@ -513,7 +513,7 @@ test interp-14.3 {testing interp aliases} {
interp alias {a x3} froboz "" puts
interp aliases {a x3}
} froboz
-test interp-14.4 {testing interp alias - alias over master} {
+test interp-14.4 {testing interp alias - alias over parent} {
# SF Bug 641195
catch {interp delete a}
interp create a
@@ -793,32 +793,32 @@ test interp-17.6 {alias loop prevention} {
} {1 {cannot define or rename alias "b": would create a loop}}
#
-# Test robustness of Tcl_DeleteInterp when applied to a slave interpreter.
+# Test robustness of Tcl_DeleteInterp when applied to a child interpreter.
# If there are bugs in the implementation these tests are likely to expose
# the bugs as a core dump.
#
-test interp-18.1 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+test interp-18.1 {testing Tcl_DeleteInterp vs children} testinterpdelete {
list [catch {testinterpdelete} msg] $msg
} {1 {wrong # args: should be "testinterpdelete path"}}
-test interp-18.2 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+test interp-18.2 {testing Tcl_DeleteInterp vs children} testinterpdelete {
catch {interp delete a}
interp create a
testinterpdelete a
} ""
-test interp-18.3 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+test interp-18.3 {testing Tcl_DeleteInterp vs children} testinterpdelete {
catch {interp delete a}
interp create a
interp create {a b}
testinterpdelete {a b}
} ""
-test interp-18.4 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+test interp-18.4 {testing Tcl_DeleteInterp vs children} testinterpdelete {
catch {interp delete a}
interp create a
interp create {a b}
testinterpdelete a
} ""
-test interp-18.5 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+test interp-18.5 {testing Tcl_DeleteInterp vs children} testinterpdelete {
catch {interp delete a}
interp create a
interp create {a b}
@@ -826,7 +826,7 @@ test interp-18.5 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
proc dodel {x} {testinterpdelete $x}
list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
} {0 {}}
-test interp-18.6 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
+test interp-18.6 {testing Tcl_DeleteInterp vs children} testinterpdelete {
catch {interp delete a}
interp create a
interp create {a b}
@@ -1615,36 +1615,36 @@ test interp-20.49 {interp invokehidden -namespace} -setup {
set script [makeFile {
set x [namespace current]
} script]
- interp create -safe slave
+ interp create -safe child
} -body {
- slave invokehidden -namespace ::foo source $script
- slave eval {set ::foo::x}
+ child invokehidden -namespace ::foo source $script
+ child eval {set ::foo::x}
} -cleanup {
- interp delete slave
+ interp delete child
removeFile script
} -result ::foo
test interp-20.50 {Bug 2486550} -setup {
- interp create slave
+ interp create child
} -body {
- slave hide coroutine
- slave invokehidden coroutine
+ child hide coroutine
+ child invokehidden coroutine
} -cleanup {
- interp delete slave
+ interp delete child
} -returnCodes error -match glob -result *
test interp-20.50.1 {Bug 2486550} -setup {
- interp create slave
+ interp create child
} -body {
- slave hide coroutine
- catch {slave invokehidden coroutine} m o
+ child hide coroutine
+ catch {child invokehidden coroutine} m o
dict get $o -errorinfo
} -cleanup {
unset -nocomplain m 0
- interp delete slave
+ interp delete child
} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?"
while executing
"coroutine"
invoked from within
-"slave invokehidden coroutine"}
+"child invokehidden coroutine"}
test interp-21.1 {interp hidden} {
interp hidden {}
@@ -2058,8 +2058,8 @@ test interp-25.1 {testing aliasing of string commands} -setup {
test interp-26.1 {result code transmission : interp eval direct} {
# Test that all the possibles error codes from Tcl get passed up
- # from the slave interp's context to the master, even though the
- # slave nominally thinks the command is running at the root level.
+ # from the child interp's context to the parent, even though the
+ # child nominally thinks the command is running at the root level.
catch {interp delete a}
interp create a
set res {}
@@ -2085,7 +2085,7 @@ test interp-26.2 {result code transmission : interp eval indirect} {
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
test interp-26.3 {result code transmission : aliases} {
# Test that all the possibles error codes from Tcl get passed up from the
- # slave interp's context to the master, even though the slave nominally
+ # child interp's context to the parent, even though the child nominally
# thinks the command is running at the root level.
catch {interp delete a}
interp create a
@@ -2180,7 +2180,7 @@ test interp-26.8 {errorInfo transmission: safe interps--bug 1637} -setup {
} -constraints knownBug -body {
# this test fails because the errorInfo is fully transmitted whether the
# interp is safe or not. The errorInfo should never report data from the
- # master interpreter because it could contain sensitive information.
+ # parent interpreter because it could contain sensitive information.
proc MyError {secret} {
return -code error "msg"
}
@@ -2275,22 +2275,22 @@ test interp-27.5 {interp hidden & namespaces} -setup {
test interp-27.6 {interp hidden & aliases & namespaces} -setup {
set i [interp create]
} -constraints knownBug -body {
- set v root-master
+ set v root-parent
namespace eval foo {
- variable v foo-master
+ variable v foo-parent
proc bar {interp args} {
variable v
- list "master bar called ($v) ([namespace current]) ($args)"\
+ list "parent bar called ($v) ([namespace current]) ($args)"\
[interp invokehidden $interp foo::bar $args]
}
}
interp eval $i {
namespace eval foo {
namespace export *
- variable v foo-slave
+ variable v foo-child
proc bar {args} {
variable v
- return "slave bar called ($v) ([namespace current]) ($args)"
+ return "child bar called ($v) ([namespace current]) ($args)"
}
}
}
@@ -2298,7 +2298,7 @@ test interp-27.6 {interp hidden & aliases & namespaces} -setup {
$i hide foo::bar
$i alias foo::bar foo::bar $i
set res [concat $res [interp eval $i {
- set v root-slave
+ set v root-child
namespace eval test {
variable v foo-test
namespace import ::foo::*
@@ -2308,29 +2308,29 @@ test interp-27.6 {interp hidden & aliases & namespaces} -setup {
} -cleanup {
namespace delete foo
interp delete $i
-} -result {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
+} -result {{child bar called (foo-child) (::foo) (test1)} {parent bar called (foo-parent) (::foo) (test2)} {child bar called (foo-child) (::foo) (test2)}}
test interp-27.7 {interp hidden & aliases & imports & namespaces} -setup {
set i [interp create]
} -constraints knownBug -body {
- set v root-master
+ set v root-parent
namespace eval mfoo {
- variable v foo-master
+ variable v foo-parent
proc bar {interp args} {
variable v
- list "master bar called ($v) ([namespace current]) ($args)"\
+ list "parent bar called ($v) ([namespace current]) ($args)"\
[interp invokehidden $interp test::bar $args]
}
}
interp eval $i {
namespace eval foo {
namespace export *
- variable v foo-slave
+ variable v foo-child
proc bar {args} {
variable v
- return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
+ return "child bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
}
}
- set v root-slave
+ set v root-child
namespace eval test {
variable v foo-test
namespace import ::foo::*
@@ -2343,7 +2343,7 @@ test interp-27.7 {interp hidden & aliases & imports & namespaces} -setup {
} -cleanup {
namespace delete mfoo
interp delete $i
-} -result {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
+} -result {{child bar called (foo-child) (bar test1) (::tcltest) (::foo) (test1)} {parent bar called (foo-parent) (::mfoo) (test2)} {child bar called (foo-child) (test::bar test2) (::) (::foo) (test2)}}
test interp-27.8 {hiding, namespaces and integrity} knownBug {
namespace eval foo {
variable v 3
@@ -2355,25 +2355,25 @@ test interp-27.8 {hiding, namespaces and integrity} knownBug {
list [catch {interp invokehidden {} foo::bar} msg] $msg
} {1 {invalid hidden command name "foo"}}
-test interp-28.1 {getting fooled by slave's namespace ?} -setup {
+test interp-28.1 {getting fooled by child's namespace ?} -setup {
set i [interp create -safe]
- proc master {interp args} {interp hide $interp list}
+ proc parent {interp args} {interp hide $interp list}
} -body {
- $i alias master master $i
+ $i alias parent parent $i
set r [interp eval $i {
namespace eval foo {
proc list {args} {
return "dummy foo::list"
}
- master
+ parent
}
info commands list
}]
} -cleanup {
- rename master {}
+ rename parent {}
interp delete $i
} -result {}
-test interp-28.2 {master's nsName cache should not cross} -setup {
+test interp-28.2 {parent's nsName cache should not cross} -setup {
set i [interp create]
$i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
} -body {
@@ -2432,31 +2432,31 @@ test interp-29.1.7 {interp recursionlimit argument checking} {
interp delete moo
list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
-test interp-29.1.8 {slave recursionlimit argument checking} {
+test interp-29.1.8 {child recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit foo bar} msg]
interp delete moo
list $result $msg
} {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}
-test interp-29.1.9 {slave recursionlimit argument checking} {
+test interp-29.1.9 {child recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit foo} msg]
interp delete moo
list $result $msg
} {1 {expected integer but got "foo"}}
-test interp-29.1.10 {slave recursionlimit argument checking} {
+test interp-29.1.10 {child recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit 0} msg]
interp delete moo
list $result $msg
} {1 {recursion limit must be > 0}}
-test interp-29.1.11 {slave recursionlimit argument checking} {
+test interp-29.1.11 {child recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit -1} msg]
interp delete moo
list $result $msg
} {1 {recursion limit must be > 0}}
-test interp-29.1.12 {slave recursionlimit argument checking} {
+test interp-29.1.12 {child recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
interp delete moo
@@ -2549,8 +2549,8 @@ test interp-29.3.3 {recursion limit} {
set r
} {1 {too many nested evaluations (infinite loop?)} 49}
test interp-29.3.4 {recursion limit error reporting} {
- interp create slave
- set r1 [slave eval {
+ interp create child
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2564,13 +2564,13 @@ test interp-29.3.4 {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {1 {falling back due to new recursion limit}}
test interp-29.3.5 {recursion limit error reporting} {
- interp create slave
- set r1 [slave eval {
+ interp create child
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2584,13 +2584,13 @@ test interp-29.3.5 {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {1 {falling back due to new recursion limit}}
test interp-29.3.6 {recursion limit error reporting} {
- interp create slave
- set r1 [slave eval {
+ interp create child
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2604,8 +2604,8 @@ test interp-29.3.6 {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
#
@@ -2613,9 +2613,9 @@ test interp-29.3.6 {recursion limit error reporting} {
# level will only be verified when it invokes a non-bcc'd command.
#
test interp-29.3.7a {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 5}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 5}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2629,14 +2629,14 @@ test interp-29.3.7a {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.7b {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 5}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 5}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2650,14 +2650,14 @@ test interp-29.3.7b {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.7c {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 5}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 5}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2672,14 +2672,14 @@ test interp-29.3.7c {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.8a {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 4}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 4}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2693,14 +2693,14 @@ test interp-29.3.8a {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.8b {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 4}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 4}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2714,14 +2714,14 @@ test interp-29.3.8b {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.9a {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 6}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 6}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2735,14 +2735,14 @@ test interp-29.3.9a {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.9b {recursion limit error reporting} {
- interp create slave
- after 0 {interp recursionlimit slave 6}
- set r1 [slave eval {
+ interp create child
+ after 0 {interp recursionlimit child 6}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2756,14 +2756,14 @@ test interp-29.3.9b {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.10a {recursion limit error reporting} {
- interp create slave
- after 0 {slave recursionlimit 4}
- set r1 [slave eval {
+ interp create child
+ after 0 {child recursionlimit 4}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2777,14 +2777,14 @@ test interp-29.3.10a {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.10b {recursion limit error reporting} {
- interp create slave
- after 0 {slave recursionlimit 4}
- set r1 [slave eval {
+ interp create child
+ after 0 {child recursionlimit 4}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2798,14 +2798,14 @@ test interp-29.3.10b {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.11a {recursion limit error reporting} {
- interp create slave
- after 0 {slave recursionlimit 5}
- set r1 [slave eval {
+ interp create child
+ after 0 {child recursionlimit 5}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2819,14 +2819,14 @@ test interp-29.3.11a {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.11b {recursion limit error reporting} {
- interp create slave
- after 0 {slave recursionlimit 5}
- set r1 [slave eval {
+ interp create child
+ after 0 {child recursionlimit 5}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2841,14 +2841,14 @@ test interp-29.3.11b {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.12a {recursion limit error reporting} {
- interp create slave
- after 0 {slave recursionlimit 6}
- set r1 [slave eval {
+ interp create child
+ after 0 {child recursionlimit 6}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2862,14 +2862,14 @@ test interp-29.3.12a {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.3.12b {recursion limit error reporting} {
- interp create slave
- after 0 {slave recursionlimit 6}
- set r1 [slave eval {
+ interp create child
+ after 0 {child recursionlimit 6}
+ set r1 [child eval {
catch { # nesting level 1
eval { # 2
eval { # 3
@@ -2884,8 +2884,8 @@ test interp-29.3.12b {recursion limit error reporting} {
}
} msg
}]
- set r2 [slave eval { set msg }]
- interp delete slave
+ set r2 [child eval { set msg }]
+ interp delete child
list $r1 $r2
} {0 ok}
test interp-29.4.1 {recursion limit inheritance} {
@@ -2916,121 +2916,121 @@ test interp-29.4.2 {recursion limit inheritance} {
interp delete $i
set r
} 50
-test interp-29.5.1 {does slave recursion limit affect master?} {
+test interp-29.5.1 {does child recursion limit affect parent?} {
set before [interp recursionlimit {}]
set i [interp create]
interp recursionlimit $i 20000
set after [interp recursionlimit {}]
- set slavelimit [interp recursionlimit $i]
+ set childlimit [interp recursionlimit $i]
interp delete $i
- list [expr {$before == $after}] $slavelimit
+ list [expr {$before == $after}] $childlimit
} {1 20000}
-test interp-29.5.2 {does slave recursion limit affect master?} {
+test interp-29.5.2 {does child recursion limit affect parent?} {
set before [interp recursionlimit {}]
set i [interp create]
interp recursionlimit $i 20000
set after [interp recursionlimit {}]
- set slavelimit [$i recursionlimit]
+ set childlimit [$i recursionlimit]
interp delete $i
- list [expr {$before == $after}] $slavelimit
+ list [expr {$before == $after}] $childlimit
} {1 20000}
-test interp-29.5.3 {does slave recursion limit affect master?} {
+test interp-29.5.3 {does child recursion limit affect parent?} {
set before [interp recursionlimit {}]
set i [interp create]
$i recursionlimit 20000
set after [interp recursionlimit {}]
- set slavelimit [interp recursionlimit $i]
+ set childlimit [interp recursionlimit $i]
interp delete $i
- list [expr {$before == $after}] $slavelimit
+ list [expr {$before == $after}] $childlimit
} {1 20000}
-test interp-29.5.4 {does slave recursion limit affect master?} {
+test interp-29.5.4 {does child recursion limit affect parent?} {
set before [interp recursionlimit {}]
set i [interp create]
$i recursionlimit 20000
set after [interp recursionlimit {}]
- set slavelimit [$i recursionlimit]
+ set childlimit [$i recursionlimit]
interp delete $i
- list [expr {$before == $after}] $slavelimit
+ list [expr {$before == $after}] $childlimit
} {1 20000}
test interp-29.6.1 {safe interpreter recursion limit} {
- interp create slave -safe
- set n [interp recursionlimit slave]
- interp delete slave
+ interp create child -safe
+ set n [interp recursionlimit child]
+ interp delete child
set n
} 1000
test interp-29.6.2 {safe interpreter recursion limit} {
- interp create slave -safe
- set n [slave recursionlimit]
- interp delete slave
+ interp create child -safe
+ set n [child recursionlimit]
+ interp delete child
set n
} 1000
test interp-29.6.3 {safe interpreter recursion limit} {
- interp create slave -safe
- set n1 [interp recursionlimit slave 42]
- set n2 [interp recursionlimit slave]
- interp delete slave
+ interp create child -safe
+ set n1 [interp recursionlimit child 42]
+ set n2 [interp recursionlimit child]
+ interp delete child
list $n1 $n2
} {42 42}
test interp-29.6.4 {safe interpreter recursion limit} {
- interp create slave -safe
- set n1 [slave recursionlimit 42]
- set n2 [interp recursionlimit slave]
- interp delete slave
+ interp create child -safe
+ set n1 [child recursionlimit 42]
+ set n2 [interp recursionlimit child]
+ interp delete child
list $n1 $n2
} {42 42}
test interp-29.6.5 {safe interpreter recursion limit} {
- interp create slave -safe
- set n1 [interp recursionlimit slave 42]
- set n2 [slave recursionlimit]
- interp delete slave
+ interp create child -safe
+ set n1 [interp recursionlimit child 42]
+ set n2 [child recursionlimit]
+ interp delete child
list $n1 $n2
} {42 42}
test interp-29.6.6 {safe interpreter recursion limit} {
- interp create slave -safe
- set n1 [slave recursionlimit 42]
- set n2 [slave recursionlimit]
- interp delete slave
+ interp create child -safe
+ set n1 [child recursionlimit 42]
+ set n2 [child recursionlimit]
+ interp delete child
list $n1 $n2
} {42 42}
test interp-29.6.7 {safe interpreter recursion limit} {
- interp create slave -safe
- set n1 [slave recursionlimit 42]
- set n2 [slave recursionlimit]
- interp delete slave
+ interp create child -safe
+ set n1 [child recursionlimit 42]
+ set n2 [child recursionlimit]
+ interp delete child
list $n1 $n2
} {42 42}
test interp-29.6.8 {safe interpreter recursion limit} {
- interp create slave -safe
- set n [catch {slave eval {interp recursionlimit {} 42}} msg]
- interp delete slave
+ interp create child -safe
+ set n [catch {child eval {interp recursionlimit {} 42}} msg]
+ interp delete child
list $n $msg
} {1 {permission denied: safe interpreters cannot change recursion limit}}
test interp-29.6.9 {safe interpreter recursion limit} {
- interp create slave -safe
+ interp create child -safe
set result [
- slave eval {
- interp create slave2 -safe
+ child eval {
+ interp create child2 -safe
set n [catch {
- interp recursionlimit slave2 42
+ interp recursionlimit child2 42
} msg]
list $n $msg
}
]
- interp delete slave
+ interp delete child
set result
} {1 {permission denied: safe interpreters cannot change recursion limit}}
test interp-29.6.10 {safe interpreter recursion limit} {
- interp create slave -safe
+ interp create child -safe
set result [
- slave eval {
- interp create slave2 -safe
+ child eval {
+ interp create child2 -safe
set n [catch {
- slave2 recursionlimit 42
+ child2 recursionlimit 42
} msg]
list $n $msg
}
]
- interp delete slave
+ interp delete child
set result
} {1 {permission denied: safe interpreters cannot change recursion limit}}
@@ -3559,44 +3559,44 @@ test interp-36.2 {interp bgerror syntax} -body {
interp bgerror x y z
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.3 {interp bgerror syntax} -setup {
- interp create slave
+ interp create child
} -body {
- slave bgerror x y
+ child bgerror x y
} -cleanup {
- interp delete slave
-} -returnCodes error -result {wrong # args: should be "slave bgerror ?cmdPrefix?"}
-test interp-36.4 {SlaveBgerror syntax} -setup {
- interp create slave
+ interp delete child
+} -returnCodes error -result {wrong # args: should be "child bgerror ?cmdPrefix?"}
+test interp-36.4 {ChildBgerror syntax} -setup {
+ interp create child
} -body {
- slave bgerror \{
+ child bgerror \{
} -cleanup {
- interp delete slave
+ interp delete child
} -returnCodes error -result {cmdPrefix must be list of length >= 1}
-test interp-36.5 {SlaveBgerror syntax} -setup {
- interp create slave
+test interp-36.5 {ChildBgerror syntax} -setup {
+ interp create child
} -body {
- slave bgerror {}
+ child bgerror {}
} -cleanup {
- interp delete slave
+ interp delete child
} -returnCodes error -result {cmdPrefix must be list of length >= 1}
-test interp-36.6 {SlaveBgerror returns handler} -setup {
- interp create slave
+test interp-36.6 {ChildBgerror returns handler} -setup {
+ interp create child
} -body {
- slave bgerror {foo bar soom}
+ child bgerror {foo bar soom}
} -cleanup {
- interp delete slave
+ interp delete child
} -result {foo bar soom}
-test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
- interp create slave
- slave alias handler handler
- slave bgerror handler
+test interp-36.7 {ChildBgerror sets error handler of child [1999035]} -setup {
+ interp create child
+ child alias handler handler
+ child bgerror handler
variable result {untouched}
proc handler {args} {
variable result
set result [lindex $args 0]
}
} -body {
- slave eval {
+ child eval {
variable done {}
after 0 error foo
after 10 [list ::set [namespace which -variable done] {}]
@@ -3606,7 +3606,7 @@ test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
} -cleanup {
variable result {}
unset -nocomplain result
- interp delete slave
+ interp delete child
} -result foo
test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
@@ -3667,7 +3667,7 @@ test interp-38.8 {interp debug basic setup} -body {
# cleanup
unset -nocomplain hidden_cmds
-foreach i [interp slaves] {
+foreach i [interp children] {
interp delete $i
}
::tcltest::cleanupTests
diff --git a/tests/io.test b/tests/io.test
index 73481ca..2752408 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
}
namespace eval ::tcl::test::io {
@@ -38,12 +38,13 @@ namespace eval ::tcl::test::io {
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
-testConstraint openpipe 1
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testobj [llength [info commands testobj]]
+testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -481,7 +482,7 @@ test io-6.6 {Tcl_GetsObj: loop test} {
close $f
set x
} [list 256 $a]
-test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
+test io-6.7 {Tcl_GetsObj: error in input} stdio {
# if (FilterInputBytes(chanPtr, &gs) != 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -741,7 +742,7 @@ test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
close $f
set x
} [list 15 "123456789012345" 15]
-test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
+test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel fileevent} {
# (FilterInputBytes() != 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -880,7 +881,7 @@ test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
close $f
set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
-test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
+test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} {
# if (chanPtr->flags & INPUT_SAW_CR)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -897,7 +898,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
+test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} {
# not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -914,7 +915,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
+test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} {
# Tcl_ExternalToUtf()
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -931,7 +932,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio test
close $f
set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
-test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
+test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel fileevent} {
# memmove()
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1056,7 +1057,7 @@ test io-6.55 {Tcl_GetsObj: overconverted} {
close $f
set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
-test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
+test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
update
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -buffering none
@@ -1116,7 +1117,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
close $f
set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
-test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
+test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
@@ -1151,7 +1152,7 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel}
close $f
set x
} "7"
-test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
+test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel fileevent} {
# not (bufPtr->nextPtr == NULL)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1171,7 +1172,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha
close $f
set x
} [list -1 "" 42 15 "123456789012345" 25]
-test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
+test io-8.3 {PeekAhead: no cached data available} {stdio testchannel fileevent} {
# (bytesLeft == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1204,7 +1205,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x
} $a
unset a
-test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
+test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fileevent} {
# (bufPtr->nextAdded < bufPtr->length)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1216,7 +1217,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
+test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileevent} {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1228,7 +1229,7 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
+test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} {
# Make sure bytes are removed from buffer.
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1393,7 +1394,7 @@ test io-12.3 {ReadChars: allocate more space} {
close $f
set x
} {abcdefghijklmnopqrstuvwxyz}
-test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
+test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
# (srcRead == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1418,7 +1419,7 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
close $f
set x
} [list "123456789012345" 1 "\u672c" 0]
-test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} {
+test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
gets stdin; puts -nonewline "\xe7"
@@ -1612,7 +1613,7 @@ test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
close $f
set x
} "abcd\ndef\nfgh"
-test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
+test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel fileevent} {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
@@ -1638,7 +1639,7 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testc
close $f
set x
} [list "abcdefghj\n" 1 "01234" 0]
-test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
+test io-13.7 {TranslateInputEOL: auto mode: naked \r} testchannel {
# (src >= srcMax)
set f [open $path(test1) w]
@@ -1783,7 +1784,7 @@ test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
set l
} {line line none}
set path(test3) [makeFile {} test3]
-test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
+test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec {
set f [open $path(test1) w]
puts -nonewline $f {
close stdin
@@ -1873,7 +1874,7 @@ test io-14.7 {Tcl_GetChannel: stdio name translation} {
set result
} {{} {} {can not find channel named "stderr"}}
set path(script) [makeFile {} script]
-test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
+test io-14.8 {reuse of stdio special channels} stdio {
file delete $path(script)
file delete $path(test1)
set f [open $path(script) w]
@@ -1895,7 +1896,7 @@ test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
close $f
set c
} hello
-test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
+test io-14.9 {reuse of stdio special channels} {stdio fileevent} {
file delete $path(script)
file delete $path(test1)
set f [open $path(script) w]
@@ -2078,7 +2079,7 @@ test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
set x
} {{{} {}} {auto lf}}
set path(stdout) [makeFile {} stdout]
-test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
+test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio {
set f [open $path(script) w]
puts -nonewline $f {
close stdout
@@ -2152,7 +2153,7 @@ test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
set l
} {6 6 0 6}
-test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
+test io-26.1 {Tcl_GetChannelInstanceData} stdio {
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
@@ -2229,7 +2230,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
- {stdio asyncPipeClose openpipe knownMsvcBug} {
+ {stdio asyncPipeClose knownMsvcBug} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2298,7 +2299,7 @@ test io-28.2 {CloseChannel called when all references are dropped} {
set l
} abcdef
test io-28.3 {CloseChannel, not called before output queue is empty} \
- {stdio asyncPipeClose nonPortable openpipe} {
+ {stdio asyncPipeClose nonPortable} {
file delete $path(pipe)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2355,7 +2356,7 @@ test io-28.4 {Tcl_Close} {testchannel} {
$consoleFileNames]
string compare $l $x
} 0
-test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} {
+test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -2494,7 +2495,7 @@ test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
close $f2
file size $path(test1)
} 377
-test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
+test io-29.12 {Tcl_WriteChars on a pipe} stdio {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -2519,7 +2520,7 @@ test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
close $f2
set y
} ok
-test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
+test io-29.13 {Tcl_WriteChars to a pipe, line buffered} stdio {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -2570,7 +2571,7 @@ test io-29.15 {Tcl_Flush, channel not open for writing} {
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
-test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
+test io-29.16 {Tcl_Flush on pipe opened only for reading} stdio {
set fd [open "|[list [interpreter] cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
@@ -2644,7 +2645,7 @@ test io-29.20 {Implicit flush when buffer is full} {
lappend z [file size $path(test1)]
set z
} {4096 12288 12600}
-test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
+test io-29.21 {Tcl_Flush to pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {set x [read stdin 6]}
@@ -2658,7 +2659,7 @@ test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
catch {close $f1}
set x
} "read 6 characters"
-test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
+test io-29.22 {Tcl_Flush called at other end of pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -2681,7 +2682,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
close $f1
set x
} {hello hello bye}
-test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
+test io-29.23 {Tcl_Flush and line buffering at end of pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -2716,7 +2717,7 @@ test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
close $f
set x
} "{} {Line 1\nLine 2}"
-test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
+test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileevent} {
file delete $path(test3)
set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
puts $f "Line 1"
@@ -2728,7 +2729,7 @@ test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpi
close $f
set x
} "Line 1\nLine 2\n"
-test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
+test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
set f [open "|[list cat -u]" r+]
puts $f "Line1"
flush $f
@@ -2736,7 +2737,7 @@ test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs
close $f
set x
} {Line1}
-test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
+test io-29.27 {Tcl_Flush on closed pipeline} stdio {
file delete $path(pipe)
set f [open $path(pipe) w]
puts $f {exit}
@@ -2790,7 +2791,7 @@ test io-29.30 {Tcl_WriteChars, crlf mode} {
close $f
file size $path(test1)
} 25
-test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+test io-29.31 {Tcl_WriteChars, background flush} stdio {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2827,13 +2828,13 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
set result ok
}
# allow a little time for the background process to close.
- # otherwise, the following test fails on the [file delete $path(output)
+ # otherwise, the following test fails on the [file delete $path(output)]
# on Windows because a process still has the file open.
after 100 set v 1; vwait v
set result
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
- {stdio asyncPipeClose openpipe knownMsvcBug} {
+ {stdio asyncPipeClose knownMsvcBug} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -4093,7 +4094,7 @@ test io-32.9 {Tcl_Read, read to end of file} {
}
set x
} ok
-test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.10 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4105,7 +4106,7 @@ test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
close $f1
set x
} "hello\n"
-test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4124,7 +4125,7 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
-test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11.1 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {chan configure stdout -translation crlf}
@@ -4144,7 +4145,7 @@ test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
-test io-32.11.2 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11.2 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {chan configure stdout -translation crlf}
@@ -4255,7 +4256,7 @@ test io-33.2 {Tcl_Gets into variable} {
close $f1
set z
} ok
-test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
+test io-33.3 {Tcl_Gets from pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4563,7 +4564,7 @@ test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
close $f1
list $c1 $r1 $c2
} {44 rstuv 49}
-test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
+test io-34.8 {Tcl_Seek on pipes: not supported} stdio {
set f1 [open "|[list [interpreter]]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
@@ -4671,13 +4672,13 @@ test io-34.15 {Tcl_Tell combined with seeking} {
close $f1
list $c1 $c2
} {10 20}
-test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test io-34.16 {Tcl_Tell on pipe: always -1} stdio {
set f1 [open "|[list [interpreter]]" r+]
set c [tell $f1]
close $f1
set c
} -1
-test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test io-34.17 {Tcl_Tell on pipe: always -1} stdio {
set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello}
flush $f1
@@ -4776,7 +4777,7 @@ test io-35.1 {Tcl_Eof} {
close $f
set x
} {0 0 0 0 1 1}
-test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
+test io-35.2 {Tcl_Eof with pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
@@ -4794,7 +4795,7 @@ test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
close $f1
set x
} {0 0 0 1}
-test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
+test io-35.3 {Tcl_Eof with pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
@@ -4828,7 +4829,7 @@ test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
close $f
set l
} {{} 1}
-test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
+test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio {
file delete $path(pipe)
set f [open $path(pipe) w]
puts $f {
@@ -5105,7 +5106,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
# Test Tcl_InputBlocked
-test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
+test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
@@ -5124,7 +5125,7 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
+test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
chan configure $f1 -encoding binary -translation lf -eofchar {}
puts $f1 {
@@ -5147,7 +5148,7 @@ test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
+test io-36.2 {Tcl_InputBlocked on blocking pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
@@ -5411,7 +5412,7 @@ test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
close $f1
set x
} {1 0 {} {} 0 1}
-test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
+test io-39.10 {Tcl_SetChannelOption, blocking mode} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -5502,7 +5503,7 @@ test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
close $f
set result
} {1 {unknown encoding "foobar"}}
-test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
+test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xe7"
@@ -5851,7 +5852,7 @@ test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs f
test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
set result {}
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
fileevent $f r "read f"
@@ -5872,7 +5873,7 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
test io-44.1 {FileEventProc procedure: normal read event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
fileevent $f2 readable [namespace code {
set x [gets $f2]; fileevent $f2 readable {}
}]
@@ -5885,7 +5886,7 @@ test io-44.1 {FileEventProc procedure: normal read event} -setup {
catch {close $f3}
} -result {text}
test io-44.2 {FileEventProc procedure: error in read event} -constraints {
- stdio unixExecs fileevent openpipe
+ stdio unixExecs fileevent
} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
@@ -5908,7 +5909,7 @@ test io-44.2 {FileEventProc procedure: error in read event} -constraints {
test io-44.3 {FileEventProc procedure: normal write event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
fileevent $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5927,7 +5928,7 @@ test io-44.3 {FileEventProc procedure: normal write event} -setup {
catch {close $f3}
} -result {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
- stdio unixExecs fileevent openpipe
+ stdio unixExecs fileevent
} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
@@ -5946,7 +5947,9 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
catch {close $f2}
catch {close $f3}
} -result {bad-write {}}
-test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs fileevent
+} -body {
set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
fileevent $f4 readable [namespace code {
if {[gets $f4 line] < 0} {
@@ -5959,9 +5962,10 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ close $f4
+} -result {initial foo eof}
close $f
@@ -6084,7 +6088,7 @@ test io-45.3 {DeleteFileEvent, cleanup on close} {fileevent} {
# Execute these tests only if the "testfevent" command is present.
-test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
+test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} {
testfevent create
set script "set f \[[list open $path(foo) r]]\n"
append script {
@@ -6094,9 +6098,10 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
fileevent $f readable {}
}]
}
+ set timer [after 10 lappend x timeout]
testfevent cmd $script
- after 1 ;# We must delay because Windows takes a little time to notice
- update
+ vwait x
+ after cancel $timer
testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
@@ -6285,7 +6290,7 @@ test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
list $x $l
} {done {called called called called called called called}}
set path(my_script) [makeFile {} my_script]
-test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} {
+test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileevent} {
set f [open $path(bar) w]
puts $f abcdefg
puts $f abcdefg
@@ -6783,47 +6788,57 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {testchannelevent} {
+test io-50.1 {testing handler deletion} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f]]
+ update
proc delhandler {f} {
variable z
set z called
testchannelevent $f delete 0
}
set z not_called
- update
- close $f
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f]]
+ testservicemode 1
+ vwait z
+ after cancel $timer
set z
-} called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
+} -cleanup {
+ close $f
+} -result called
+test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
variable z
- lappend z "called delhandler $f $i"
+ lappend z "called delhandler $i"
testchannelevent $f delete 0
}
set z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list [list called delhandler $f 0] [list called delhandler $f 1]]
-} 0
-test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
+} -result {{called delhandler 0} {called delhandler 1}}
+test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
set z ""
proc notcalled {f i} {
variable z
@@ -6832,23 +6847,30 @@ test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent
proc delhandler {f i} {
variable z
testchannelevent $f delete 1
- lappend z "delhandler $f $i called"
+ lappend z "delhandler $i called"
testchannelevent $f delete 0
- lappend z "delhandler $f $i deleted myself"
+ lappend z "delhandler $i deleted myself"
}
set z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list [list delhandler $f 0 called] \
- [list delhandler $f 0 deleted myself]]
-} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -result {{delhandler 0 called} {delhandler 0 deleted myself}}
+test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+ update
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ update
proc delrecursive {f} {
variable z
variable u
@@ -6863,18 +6885,22 @@ test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
}
variable u toplevel
variable z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- {{delrecursive calling recursive} {delrecursive deleting recursive}}
-} 0
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode notOSX} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6884,39 +6910,50 @@ test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
variable z
if {"$u" == "recursive"} {
testchannelevent $f delete 1
- testchannelevent $f delete 0
lappend z "del deleted notcalled"
+ testchannelevent $f delete 0
lappend z "del deleted myself"
} else {
set u recursive
lappend z "del calling recursive"
- update
- lappend z "del after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "del after recursive"
}
}
set z ""
set u toplevel
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
+ testservicemode 1
+ set timer [after 50 set z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list {del calling recursive} {del deleted notcalled} \
- {del deleted myself} {del after update}]
-} 0
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -result [list {del calling recursive} {del deleted notcalled} \
+ {del deleted myself} {del after recursive}]
+test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
variable u
variable z
+ variable done
if {"$u" == "toplevel"} {
lappend z "first called"
set u first
- update
- lappend z "first after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "first after toplevel"
+ set done 1
} else {
lappend z "first called not toplevel"
}
@@ -6938,14 +6975,24 @@ test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
}
set z ""
set u toplevel
+ set done 0
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
update
+ if {!$done} {
+ set timer2 [after 200 set done 1]
+ vwait done
+ after cancel $timer2
+ }
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list {first called} {first called not toplevel} \
- {second called, first time} {second called, second time} \
- {first after update}]
-} 0
-
+} -result [list {first called} {first called not toplevel} \
+ {second called, first time} {second called, second time} \
+ {first after toplevel}]
test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set x 0
set result ""
@@ -7135,7 +7182,7 @@ test io-52.7 {TclCopyChannel} {fcopy} {
}
set result
} {0 0 ok}
-test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
+test io-52.8 {TclCopyChannel} {stdio fcopy} {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -7415,7 +7462,7 @@ test io-53.2 {CopyData} {fcopy} {
}
set result
} {0 0 ok}
-test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
+test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -7447,7 +7494,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
close $f
set result
} "ready line1 line2 {done\n}"
-test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} {
+test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
variable x
for {set x 0} {$x < 12} {incr x} {
@@ -7538,7 +7585,7 @@ test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
close $out
set fcopyTestDone ;# 1 for error condition
} 1
-test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} {
+test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
file delete $path(test1)
@@ -7571,7 +7618,7 @@ proc doFcopy {in out {bytes 0} {error {}}} {
-command [namespace code [list doFcopy $in $out]]]
}
}
-test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
+test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
catch {unset fcopyTestDone}
@@ -7623,7 +7670,7 @@ test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Record input size, so that result is always defined
lappend ::RES [file size $bar]
# Run the copy. Should not invoke -command now.
@@ -7664,7 +7711,7 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof}
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Initialize and force eof on the input.
seek $f 0 end ; read $f 1
set ::RES [eof $f]
@@ -7704,7 +7751,7 @@ test io-53.8b {CopyData: async callback and -size 0} -setup {
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set ::RES {}
# Run the copy. Should not invoke -command now.
fcopy $f $g -size 0 -command ::cmd
@@ -7761,7 +7808,7 @@ test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
}
set ::forever {}
set out [open $out w]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
fcopy $pipe $out -size 6 -command ::done
set token [after 5000 {
set ::forever {fcopy hangs}
@@ -7831,7 +7878,7 @@ test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
fconfigure $b -translation binary -buffering none
fileevent $a readable [list ::done $a]
fileevent $b readable [list ::done $b]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
puts $a AB
@@ -7879,7 +7926,7 @@ test io-53.11 {Bug 2895565} -setup {
removeFile out
removeFile in
} -result {40 bytes copied}
-test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix openpipe fcopy} {
+test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts -nonewline $f1 {
@@ -8294,7 +8341,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
set result
} {1 readable 234567890 timer}
-test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
+test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
set out [open $path(script) w]
puts $out {
puts "normal message from pipe"
@@ -8334,7 +8381,7 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
string equal $result [testmainthread]
} {1}
-test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
+test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
@@ -8712,16 +8759,16 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
set rfd [open $fn r]
testobj freeallvars
- interp create slave
+ interp create child
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
read [teststringobj get 1]
testobj duplicate 1 2
- interp transfer {} $rfd slave
+ interp transfer {} $rfd child
catch {read [teststringobj get 1]}
read [teststringobj get 2]
} -cleanup {
- interp delete slave
+ interp delete child
testobj freeallvars
removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 0e47d2f..749d225 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -2084,7 +2084,7 @@ test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
set ida [interp create];#puts <<$ida>>
set idb [interp create];#puts <<$idb>>
- # Magic to get the test* commands in the slaves
+ # Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
@@ -2122,7 +2122,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
set ida [interp create];#puts <<$ida>>
set idb [interp create];#puts <<$idb>>
- # Magic to get the test* commands in the slaves
+ # Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
@@ -2164,13 +2164,13 @@ test iocmd-32.2 {delete interp of reflected chan} {
# Bug 3034840
# Run this test in an interp with memory debugging to panic
# on the double free
- interp create slave
- slave eval {
+ interp create child
+ child eval {
proc no-op args {}
proc driver {sub args} {return {initialize finalize watch read}}
chan event [chan create read driver] readable no-op
}
- interp delete slave
+ interp delete child
} {}
# ### ### ### ######### ######### #########
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 0a335ff..f185117 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -36,8 +36,8 @@ testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# can access this variable.
set helperscript {
- if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+ if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -1162,7 +1162,7 @@ test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
set ida [interp create]; #puts <<$ida>>
set idb [interp create]; #puts <<$idb>>
- # Magic to get the test* commands in the slaves
+ # Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
@@ -1205,7 +1205,7 @@ test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
set ida [interp create]; #puts <<$ida>>
set idb [interp create]; #puts <<$idb>>
- # Magic to get the test* commands in the slaves
+ # Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
@@ -1244,16 +1244,16 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces
tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
- interp create slave
- # Magic to get the test* commands into the slave
- load {} Tcltest slave
+ interp create child
+ # Magic to get the test* commands into the child
+ load {} Tcltest child
} -constraints {testchannel} -body {
- # Get base channel into the slave
+ # Get base channel into the child
set c [tempchan]
testchannel cut $c
- interp eval slave [list testchannel splice $c]
- interp eval slave [list set c $c]
- slave eval {
+ interp eval child [list testchannel splice $c]
+ interp eval child [list set c $c]
+ child eval {
proc no-op args {}
proc driver {c sub args} {
return {initialize finalize read write}
@@ -1261,7 +1261,7 @@ test iortrans-11.2 {delete interp of reflected transform} -setup {
set t [chan push $c [list driver $c]]
chan event $c readable no-op
}
- interp delete slave
+ interp delete child
} -cleanup {
tempdone
} -result {}
diff --git a/tests/iogt.test b/tests/iogt.test
index 3cac2cf..fb04b5b 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -10,9 +10,9 @@
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.
-if {[catch {package require tcltest 2.1}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
diff --git a/tests/join.test b/tests/join.test
index 4aeb093..9ea554d 100644
--- a/tests/join.test
+++ b/tests/join.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lindex.test b/tests/lindex.test
index 2b1742e..f9397d2 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2.2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -449,6 +449,14 @@ test lindex-17.1 {Bug 1718580} -body {
lindex a end foo
} -match glob -result {bad index "foo"*} -returnCodes 1
+test lindex-18.0 {nested bytecode execution} -setup {
+ proc demo {i} {lindex {a b c} $i}
+} -body {
+ demo 0+0x10000000000000000
+} -cleanup {
+ rename demo {}
+}
+
catch { unset minus }
# cleanup
diff --git a/tests/link.test b/tests/link.test
index 336634b..89e5aa2 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -12,7 +12,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/linsert.test b/tests/linsert.test
index 4939e5c..ddc56a9 100644
--- a/tests/linsert.test
+++ b/tests/linsert.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/list.test b/tests/list.test
index 2686bd7..edb572c 100644
--- a/tests/list.test
+++ b/tests/list.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/listObj.test b/tests/listObj.test
index d7fb46c..ce6c978 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/llength.test b/tests/llength.test
index 169c7ca..a2770c0 100644
--- a/tests/llength.test
+++ b/tests/llength.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lmap.test b/tests/lmap.test
index 641eac2..3b52c64 100644
--- a/tests/lmap.test
+++ b/tests/lmap.test
@@ -14,7 +14,7 @@
# RCS: @(#) $Id: $
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/load.test b/tests/load.test
index 4cd1fcd..9fdf1cf 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -103,7 +103,7 @@ test load-3.1 {error in _Init procedure, same interpreter} \
"if 44 {open non_existent}"
invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
-test load-3.2 {error in _Init procedure, slave interpreter} \
+test load-3.2 {error in _Init procedure, child interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
diff --git a/tests/lpop.test b/tests/lpop.test
index 3e28978..35f0103 100644
--- a/tests/lpop.test
+++ b/tests/lpop.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lrange.test b/tests/lrange.test
index 5798707..a20422f 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lrepeat.test b/tests/lrepeat.test
index e89f1b7..f62f35f 100644
--- a/tests/lrepeat.test
+++ b/tests/lrepeat.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 4ce3ef4..0b3f7f1 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lsearch.test b/tests/lsearch.test
index b188924..6d183ad 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -12,7 +12,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -149,14 +149,14 @@ test lsearch-5.2 {binary search} {
}
set res
} $decreasingIntegers
-test lsearch-5.3 {binary search finds leftmost occurances} {
+test lsearch-5.3 {binary search finds leftmost occurrences} {
set res {}
for {set i 0} {$i < 10} {incr i} {
lappend res [lsearch -integer -sorted $repeatingIncreasingIntegers $i]
}
set res
} [list 0 5 10 15 20 25 30 35 40 45]
-test lsearch-5.4 {binary search -decreasing finds leftmost occurances} {
+test lsearch-5.4 {binary search -decreasing finds leftmost occurrences} {
set res {}
for {set i 9} {$i >= 0} {incr i -1} {
lappend res [lsearch -sorted -integer -decreasing \
diff --git a/tests/lset.test b/tests/lset.test
index b1ed110..d98a38e 100644
--- a/tests/lset.test
+++ b/tests/lset.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/lsetComp.test b/tests/lsetComp.test
index 32bfd5f..d313bbc 100644
--- a/tests/lsetComp.test
+++ b/tests/lsetComp.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
index f1758f5..0a147f0 100644
--- a/tests/macOSXFCmd.test
+++ b/tests/macOSXFCmd.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/macOSXLoad.test b/tests/macOSXLoad.test
index 12c77e0..ea4a910 100644
--- a/tests/macOSXLoad.test
+++ b/tests/macOSXLoad.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
set oldTSF $::tcltest::testSingleFile
diff --git a/tests/main.test b/tests/main.test
index 5b43b43..c7347b9 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1,8 +1,8 @@
# This file contains a collection of tests for generic/tclMain.c.
-if {[catch {package require tcltest 2.0.2}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
namespace eval ::tcl::test::main {
@@ -613,7 +613,7 @@ namespace eval ::tcl::test::main {
variable wait
chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
- set id [after 2000 [list set [namespace which -variable wait] timeout]]
+ set id [after 5000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
@@ -636,7 +636,7 @@ namespace eval ::tcl::test::main {
variable wait
chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
- set id [after 2000 [list set [namespace which -variable wait] timeout]]
+ set id [after 5000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
diff --git a/tests/mathop.test b/tests/mathop.test
index 958a56f..f4a810f 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2.1
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/misc.test b/tests/misc.test
index db8b14a..8f8516e 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 4ab3622..6e95c03 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -12,10 +12,9 @@
# Note that after running these tests, entries will be left behind in the
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.
-package require Tcl 8.5-
-if {[catch {package require tcltest 2}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
if {[catch {package require msgcat 1.6}]} {
puts stderr "Skipping tests in [info script]. No msgcat 1.6 found to test."
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 1d6a805..f503a4d 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -15,7 +15,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/namespace.test b/tests/namespace.test
index 0d93092..8209cf3 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -12,8 +12,10 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
testConstraint memory [llength [info commands memory]]
::tcltest::loadTestedCommands
@@ -179,21 +181,21 @@ test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns}
namespace delete test_ns_2
} {}
test namespace-7.7 {Bug 1655305} -setup {
- interp create slave
+ interp create child
# Can't invoke through the ensemble, since deleting the global namespace
# (indirectly, via deleting ::tcl) deletes the ensemble.
- slave eval {rename ::tcl::info::commands ::infocommands}
- slave hide infocommands
- slave eval {
+ child eval {rename ::tcl::info::commands ::infocommands}
+ child hide infocommands
+ child eval {
proc foo {} {
namespace delete ::
}
}
} -body {
- slave eval foo
- slave invokehidden infocommands
+ child eval foo
+ child invokehidden infocommands
} -cleanup {
- interp delete slave
+ interp delete child
} -result {}
test namespace-7.8 {Bug ba1419303b4c} -setup {
@@ -269,28 +271,28 @@ test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away}
[info commands test_ns_import::*]
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
- interp create slave
- slave eval {trace add execution error leave {namespace delete :: ;#}}
- catch {slave eval error foo bar baz}
- interp delete slave
+ interp create child
+ child eval {trace add execution error leave {namespace delete :: ;#}}
+ catch {child eval error foo bar baz}
+ interp delete child
set ::errorInfo
} {bar
invoked from within
-"slave eval error foo bar baz"}
+"child eval error foo bar baz"}
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
- interp create slave
- slave eval {trace add variable errorCode write {namespace delete :: ;#}}
- catch {slave eval error foo bar baz}
- interp delete slave
+ interp create child
+ child eval {trace add variable errorCode write {namespace delete :: ;#}}
+ catch {child eval error foo bar baz}
+ interp delete child
set ::errorInfo
} {bar
invoked from within
-"slave eval error foo bar baz"}
+"child eval error foo bar baz"}
test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
- interp create slave
- slave eval {trace add execution error leave {namespace delete :: ;#}}
- catch {slave eval error foo bar baz}
- interp delete slave
+ interp create child
+ child eval {trace add execution error leave {namespace delete :: ;#}}
+ catch {child eval error foo bar baz}
+ interp delete child
set ::errorCode
} baz
@@ -2797,9 +2799,9 @@ test namespace-51.15 {namespace resolution path control} -body {
namespace delete ::test_ns_2
}
test namespace-51.16 {Bug 1566526} {
- interp create slave
- slave eval namespace eval demo namespace path ::
- interp delete slave
+ interp create child
+ child eval namespace eval demo namespace path ::
+ interp delete child
} {}
test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
set result {}
@@ -3000,19 +3002,19 @@ test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
}
}
catch {rename ::noSuchCommand {}}
- set ::slave [interp create]
+ set ::child [interp create]
} -body {
- $::slave alias bar noSuchCommand
+ $::child alias bar noSuchCommand
namespace eval test_ns_1 {
namespace unknown unknown
proc unknown args {
return FAIL
}
- $::slave eval bar
+ $::child eval bar
}
} -cleanup {
- interp delete $::slave
- unset ::slave
+ interp delete $::child
+ unset ::child
namespace delete test_ns_1
rename ::unknown {}
rename unknown.save ::unknown
@@ -3337,6 +3339,49 @@ test namespace-56.5 {Bug 8b9854c3d8} -setup {
namespace delete namespace-56.5
} -result 1
+
+
+test namespace-57.0 {
+ an imported alias should be usable in the deletion trace for the alias
+
+ see 29e8848eb976
+} -body {
+ variable res {}
+ namespace eval ns2 {
+ namespace export *
+ proc p1 {oldname newname op} {
+ return success
+ }
+
+ interp alias {} [namespace current]::p2 {} [namespace which p1]
+ }
+
+
+ namespace eval ns3 {
+ namespace import ::ns2::p2
+ }
+
+
+ set ondelete [list apply [list {oldname newname op} {
+ variable res
+ catch {
+ ns3::p2 $oldname $newname $op
+ } cres
+ lappend res $cres
+ } [namespace current]]]
+
+
+ trace add command ::ns2::p2 delete $ondelete
+ rename ns2::p2 {}
+ return $res
+} -cleanup {
+ unset res
+ namespace delete ns2
+ namespace delete ns3
+} -result success
+
+
+
# cleanup
catch {rename cmd1 {}}
diff --git a/tests/notify.test b/tests/notify.test
index d2b9123..7375f83 100644
--- a/tests/notify.test
+++ b/tests/notify.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/nre.test b/tests/nre.test
index 58f5511..7cf06d1 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/obj.test b/tests/obj.test
index 5bcffa3..e10cebf 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -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/oo.test b/tests/oo.test
index c73c36c..0dc26f2 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -8,8 +8,8 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require TclOO 1.0.3
-package require tcltest 2
-if {"::tcltest" in [namespace children]} {
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -304,19 +304,19 @@ test oo-1.18.2 {Bug 75b8433707: memory leak in oo-1.18} -setup {
rename test-oo-1.18 {}
} -result 0
test oo-1.18.3 {Bug 21c144f0f5} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
oo::define [oo::class create foo] superclass oo::class
oo::class destroy
}
} -cleanup {
- interp delete slave
+ interp delete child
}
test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
oo::class create A
oo::class create B {
superclass oo::class
@@ -328,12 +328,12 @@ test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
[B create C] create d
}
} -returnCodes error -cleanup {
- interp delete slave
+ interp delete child
} -result {class should only be a direct superclass once}
test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
oo::class create A
oo::class create B {
superclass oo::class
@@ -345,7 +345,7 @@ test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
[B create C {B C}] create d
}
} -returnCodes error -cleanup {
- interp delete slave
+ interp delete child
} -result {attempt to form circular dependency graph}
test oo-1.19 {basic test of OO functionality: teardown order} -body {
oo::object create o
@@ -1439,16 +1439,16 @@ test oo-7.8 {OO: next at the end of the method chain} -setup {
} -result {foo2 foo 1 {no next method implementation}}
test oo-7.9 {OO: defining inheritance in namespaces} -setup {
set ::result {}
- oo::class create ::master
+ oo::class create ::parent
namespace eval ::foo {
- oo::class create mixin {superclass ::master}
+ oo::class create mixin {superclass ::parent}
}
} -cleanup {
- ::master destroy
+ ::parent destroy
namespace delete ::foo
} -body {
namespace eval ::foo {
- oo::class create bar {superclass master}
+ oo::class create bar {superclass parent}
oo::class create boo
oo::define boo {superclass bar}
oo::define boo {mixin mixin}
@@ -2135,18 +2135,18 @@ test oo-14.5 {OO and mixins and filters - advanced case} -setup {
mix destroy
} -result >>foobar<<
test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create A {
- superclass master
+ superclass parent
method egg {} {
return chicken
}
}
oo::class create B {
- superclass master
+ superclass parent
mixin A
method bar {} {
# mixin from A
@@ -2154,7 +2154,7 @@ test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
}
}
oo::class create C {
- superclass master
+ superclass parent
mixin B
method foo {} {
# mixin from B
@@ -2164,12 +2164,12 @@ test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
[C new] foo
} -result chicken
test oo-14.7 {OO and filters from mixins of mixins} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create A {
- superclass master
+ superclass parent
method egg {} {
return chicken
}
@@ -2180,7 +2180,7 @@ test oo-14.7 {OO and filters from mixins of mixins} -setup {
}
}
oo::class create B {
- superclass master
+ superclass parent
mixin A
filter f
method bar {} {
@@ -2189,7 +2189,7 @@ test oo-14.7 {OO and filters from mixins of mixins} -setup {
}
}
oo::class create C {
- superclass master
+ superclass parent
mixin B
filter f
method foo {} {
@@ -2201,18 +2201,18 @@ test oo-14.7 {OO and filters from mixins of mixins} -setup {
} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
test oo-14.8 {OO: class mixin order - Bug 1998221} -setup {
set ::result {}
- oo::class create master {
+ oo::class create parent {
method test {} {}
}
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create mix {
- superclass master
+ superclass parent
method test {} {lappend ::result mix; next; return $::result}
}
oo::class create cls {
- superclass master
+ superclass parent
mixin mix
method test {} {lappend ::result cls; next; return $::result}
}
@@ -2915,13 +2915,13 @@ test oo-18.7 {OO: objdefine command support} -setup {
invoked from within
"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
test oo-18.8 {OO: define/self command support} -setup {
- oo::class create master
- oo::class create ::foo {superclass master}
+ oo::class create parent
+ oo::class create ::foo {superclass parent}
} -body {
catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
dict get $opt -errorinfo
} -cleanup {
- master destroy
+ parent destroy
} -result {foobar
while executing
"error foobar"
@@ -2932,15 +2932,15 @@ test oo-18.8 {OO: define/self command support} -setup {
invoked from within
"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
test oo-18.9 {OO: define/self command support} -setup {
- oo::class create master
+ oo::class create parent
set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
- superclass master
+ superclass parent
}]
} -body {
catch {oo::define $c {error err}} msg opt
dict get $opt -errorinfo
} -cleanup {
- master destroy
+ parent destroy
} -result {err
while executing
"error err"
@@ -2948,13 +2948,13 @@ test oo-18.9 {OO: define/self command support} -setup {
invoked from within
"oo::define $c {error err}"}
test oo-18.10 {OO: define/self command support} -setup {
- oo::class create master
- oo::class create ::foo {superclass master}
+ oo::class create parent
+ oo::class create ::foo {superclass parent}
} -body {
catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
dict get $opt -errorinfo
} -cleanup {
- master destroy
+ parent destroy
} -result {foobar
while executing
"error foobar"
@@ -2965,13 +2965,13 @@ test oo-18.10 {OO: define/self command support} -setup {
invoked from within
"oo::define foo {self {rename ::foo {}; error foobar}}"}
test oo-18.11 {OO: define/self command support} -setup {
- oo::class create master
- oo::class create ::foo {superclass master}
+ oo::class create parent
+ oo::class create ::foo {superclass parent}
} -body {
catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
dict get $opt -errorinfo
} -cleanup {
- master destroy
+ parent destroy
} -result {this command cannot be called when the object has been deleted
while executing
"self {error foobar}"
@@ -3594,12 +3594,12 @@ test oo-27.2 {variables declaration - object introspection} -setup {
info object variables foo
} -result {a b c}
test oo-27.3 {variables declaration - basic behaviour} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3609,13 +3609,13 @@ test oo-27.3 {variables declaration - basic behaviour} -setup {
bar y
} -result 3
test oo-27.4 {variables declaration - destructors too} -setup {
- oo::class create master
+ oo::class create parent
set result bad!
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3640,12 +3640,12 @@ test oo-27.5 {variables declaration - object-bound variables} -setup {
foo y
} -result 2
test oo-27.6 {variables declaration - non-interference of levels} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3660,12 +3660,12 @@ test oo-27.6 {variables declaration - non-interference of levels} -setup {
list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
} -result {{3 2 y! {}} {x! y!} {x! y!}}
test oo-27.7 {variables declaration - one underlying variable space} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3692,12 +3692,12 @@ test oo-27.9 {variables declaration - error cases - arrays} -body {
oo::define oo::object variable bad(var)
} -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element}
test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable clsvar
constructor {} {
set clsvar 0
@@ -3720,12 +3720,12 @@ test oo-27.10 {variables declaration - no instance var leaks with class resolver
list [inst1 value] [inst2 value]
} -result {3 2}
test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable clsvar
constructor {} {
set clsvar 0
@@ -3793,12 +3793,12 @@ test oo-27.13 {variables declaration: Bug 3185009: require refcount management}
foo destroy
} -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}}
test oo-27.14 {variables declaration - multiple use} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x
variable y
method boo {} {
@@ -3809,12 +3809,12 @@ test oo-27.14 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 2,2}
test oo-27.15 {variables declaration - multiple use} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable
variable x y
method boo {} {
@@ -3825,12 +3825,12 @@ test oo-27.15 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 2,2}
test oo-27.16 {variables declaration - multiple use} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x
variable -clear
variable y
@@ -3842,12 +3842,12 @@ test oo-27.16 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 1,2}
test oo-27.17 {variables declaration - multiple use} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x
variable -set y
method boo {} {
@@ -3858,12 +3858,12 @@ test oo-27.17 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 1,2}
test oo-27.18 {variables declaration - multiple use} -setup {
- oo::class create master
+ oo::class create parent
} -cleanup {
- master destroy
+ parent destroy
} -body {
oo::class create foo {
- superclass master
+ superclass parent
variable x
variable -? y
method boo {} {
@@ -3961,12 +3961,12 @@ test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
} -result {v t}
test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
oo::class create Super
- oo::class create Master {
+ oo::class create Parent {
superclass Super
variable member1 member2
constructor {} {
- set member1 master1
- set member2 master2
+ set member1 parent1
+ set member2 parent2
}
method getChild {} {
Child new [self]
@@ -3987,10 +3987,10 @@ test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
method result {} {return $result}
}
} -body {
- [[Master new] getChild] result
+ [[Parent new] getChild] result
} -cleanup {
Super destroy
-} -result {master1 master2 master1 master2 master1 master2 master1 master2}
+} -result {parent1 parent2 parent1 parent2 parent1 parent2 parent1 parent2}
# A feature that's not supported because the mechanism may change without
# warning, but is supposed to work...
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
index 6a48d28..0ec7cdd 100644
--- a/tests/ooNext2.test
+++ b/tests/ooNext2.test
@@ -8,8 +8,8 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require TclOO 1.0.3
-package require tcltest 2
-if {"::tcltest" in [namespace children]} {
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -882,9 +882,9 @@ test oo-call-3.4 {current call introspection: in destructors} -setup {
# caller
set testopts {
-setup {
- oo::class create Master
+ oo::class create Parent
oo::class create Foo {
- superclass Master
+ superclass Parent
method bar {} {
puts abc
tailcall puts hi
@@ -892,11 +892,11 @@ set testopts {
}
}
oo::class create Foo2 {
- superclass Master
+ superclass Parent
}
}
-cleanup {
- Master destroy
+ Parent destroy
}
}
diff --git a/tests/ooUtil.test b/tests/ooUtil.test
index ff7093f..7fc9b9c 100644
--- a/tests/ooUtil.test
+++ b/tests/ooUtil.test
@@ -10,8 +10,8 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require TclOO 1.0.3
-package require tcltest 2
-if {"::tcltest" in [namespace children]} {
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -153,7 +153,7 @@ test ooUtil-1.8 {TIP 478: classmethod in child interp} -setup {
oo::class create Table {
superclass ActiveRecord
}
- # This is confirming that this is not the master interpreter
+ # This is confirming that this is not the parent interpreter
list [Table find foo bar] [info globals childinterp]
}
} -cleanup {
diff --git a/tests/opt.test b/tests/opt.test
index 14a6e04..0af4488 100644
--- a/tests/opt.test
+++ b/tests/opt.test
@@ -11,13 +11,13 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
# the package we are going to test
-package require opt 0.4.7
+package require opt 0.4.8
# we are using implementation specifics to test the package
diff --git a/tests/package.test b/tests/package.test
index 2dca06b..1223d82 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -13,16 +13,16 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.3.3
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-# Do all this in a slave interp to avoid garbaging the package list
+# Do all this in a child interp to avoid garbaging the package list
set i [interp create]
-tcltest::loadIntoSlaveInterpreter $i {*}$argv
+tcltest::loadIntoChildInterpreter $i {*}$argv
catch [list load {} Tcltest $i]
interp eval $i {
namespace import -force ::tcltest::*
@@ -945,15 +945,15 @@ test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
# No tests for FindPackage; can't think up anything detectable errors.
test package-5.1 {TclFreePackageInfo procedure} {
- interp create slave
- slave eval {
+ interp create child
+ child eval {
package ifneeded t 2.3 x
package ifneeded t 2.4 y
package ifneeded x 3.1 z
package provide q 4.3
package unknown "will this get freed?"
}
- interp delete slave
+ interp delete child
} {}
test package-5.2 {TclFreePackageInfo procedure} -body {
interp create foo
diff --git a/tests/parse.test b/tests/parse.test
index 287c392..94c7f74 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -8,9 +8,9 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[catch {package require tcltest 2.0.2}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
namespace eval ::tcl::test::parse {
@@ -405,14 +405,14 @@ test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv {
proc ::unknown args {lappend ::info [info level]; uplevel 1 foo}
proc ::foo args {lappend ::info global}
catch {rename ::noSuchCommand {}}
- set ::slave [interp create]
- $::slave alias bar noSuchCommand
+ set ::child [interp create]
+ $::child alias bar noSuchCommand
set ::info {}
namespace eval test_ns_1 {
proc foo args {lappend ::info namespace}
- $::slave eval bar
- testevalobjv 1 [list $::slave eval bar]
- uplevel #0 [list $::slave eval bar]
+ $::child eval bar
+ testevalobjv 1 [list $::child eval bar]
+ uplevel #0 [list $::child eval bar]
}
namespace delete test_ns_1
rename ::foo {}
@@ -429,14 +429,14 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
lappend ::info ns
}]
catch {rename ::noSuchCommand {}}
- set ::slave [interp create]
- $::slave alias bar noSuchCommand
+ set ::child [interp create]
+ $::child alias bar noSuchCommand
set ::info {}
namespace eval test_ns_1 {
- $::slave eval bar
+ $::child eval bar
}
namespace delete test_ns_1
- interp delete $::slave
+ interp delete $::child
catch {rename ::noSuchCommand {}}
set ::info
} global
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 47dbec5..8b5e429 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -8,8 +8,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 504d063..134a3c2 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,8 +13,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/pid.test b/tests/pid.test
index af21f30..47f753b 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 8ff806c..8121377 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -8,8 +8,10 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
set fullPkgPath [makeDirectory pkg]
@@ -72,11 +74,11 @@ proc pkgtest::parseArgs { args } {
# of the command line.
proc pkgtest::parseIndex { filePath } {
- # create a slave interpreter, where we override "package ifneeded"
+ # create a child interpreter, where we override "package ifneeded"
- set slave [interp create]
+ set child [interp create]
if {[catch {
- $slave eval {
+ $child eval {
rename package package_original
proc package { args } {
if {[lindex $args 0] eq "ifneeded"} {
@@ -91,17 +93,17 @@ proc pkgtest::parseIndex { filePath } {
}
set dir [file dirname $filePath]
- $slave eval {set curdir [pwd]}
- $slave eval [list cd $dir]
- $slave eval [list set dir $dir]
- $slave eval [list source [file tail $filePath]]
- $slave eval {cd $curdir}
+ $child eval {set curdir [pwd]}
+ $child eval [list cd $dir]
+ $child eval [list set dir $dir]
+ $child eval [list source [file tail $filePath]]
+ $child eval {cd $curdir}
# Create the list in sorted order, so that we don't get spurious
# errors because the order has changed.
array set P {}
- foreach {k v} [$slave eval {array get ::PKGS}] {
+ foreach {k v} [$child eval {array get ::PKGS}] {
set P($k) $v
}
@@ -113,12 +115,12 @@ proc pkgtest::parseIndex { filePath } {
set ei [dict get $opts -errorinfo]
set ec [dict get $opts -errorcode]
- catch {interp delete $slave}
+ catch {interp delete $child}
error $ei $ec
}
- interp delete $slave
+ interp delete $child
return $PKGS
}
diff --git a/tests/platform.test b/tests/platform.test
index 53d534e..fff16fd 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
+package require tcltest 2.5
namespace eval ::tcl::test::platform {
namespace import ::tcltest::testConstraint
diff --git a/tests/proc-old.test b/tests/proc-old.test
index e45cf5c..79ee1fa 100644
--- a/tests/proc-old.test
+++ b/tests/proc-old.test
@@ -14,8 +14,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/proc.test b/tests/proc.test
index 43d76d8..7039dbb 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -14,7 +14,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -389,9 +389,9 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {
test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
set lambda x
lappend lambda {set a 1}
- interp create slave
- slave eval [list apply $lambda foo]
- interp delete slave
+ interp create child
+ child eval [list apply $lambda foo]
+ interp delete child
unset lambda
} {}
diff --git a/tests/process.test b/tests/process.test
index 229d33c..d7f47b2 100644
--- a/tests/process.test
+++ b/tests/process.test
@@ -8,8 +8,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/pwd.test b/tests/pwd.test
index 175c852..3486e70 100644
--- a/tests/pwd.test
+++ b/tests/pwd.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/reg.test b/tests/reg.test
index dabd3bc..847da32 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -9,8 +9,9 @@
#
# Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
@@ -287,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/regexp.test b/tests/regexp.test
index bae1217..a2e6dbb 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -192,6 +192,17 @@ test regexp-3.7 {getting substrings back from regexp} {
set foo 1; set f2 1; set f3 1; set f4 1
list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
} {1 {1 2} {1 1} {-1 -1} {2 2}}
+test regexp-3.8a {-indices by multi-byte utf-8} {
+ regexp -inline -indices {(\w+)-(\w+)} \
+ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"
+} {{0 10} {0 3} {5 10}}
+test regexp-3.8b {-indices by multi-byte utf-8, from -start position} {
+ list\
+ [regexp -inline -indices -start 3 {(\w+)-(\w+)} \
+ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] \
+ [regexp -inline -indices -start 4 {(\w+)-(\w+)} \
+ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"]
+} {{{3 10} {3 3} {5 10}} {}}
test regexp-4.1 {-nocase option to regexp} {
regexp -nocase foo abcFOo
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index 8819dd2..53a68c5 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/registry.test b/tests/registry.test
index 8cfd5be..53e48fe 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -10,8 +10,8 @@
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/rename.test b/tests/rename.test
index ebf5425..ddda909 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/resolver.test b/tests/resolver.test
index b0b395d..9916529 100644
--- a/tests/resolver.test
+++ b/tests/resolver.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-if {"::tcltest" in [namespace children]} {
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -203,7 +203,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
# resolver-agnostic).
#
# In order to make the test cases for the per-interpreter cmd literal pool
-# reproducable and to minimize interactions between test cases, we use a slave
+# reproducable and to minimize interactions between test cases, we use a child
# interpreter per test-case.
#
#
diff --git a/tests/result.test b/tests/result.test
index 859e546..f1f5fb7 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -10,8 +10,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/safe-stock.test b/tests/safe-stock.test
new file mode 100644
index 0000000..192189f
--- /dev/null
+++ b/tests/safe-stock.test
@@ -0,0 +1,248 @@
+# safe-stock.test --
+#
+# This file contains tests for safe Tcl that were previously in the file
+# safe.test, and use files and packages of stock Tcl 8.7 to perform the tests.
+# These files may be changed or disappear in future revisions of Tcl, for
+# example package opt will eventually be removed.
+#
+# The tests are replaced in safe.tcl with tests that use files provided in the
+# tests directory. Test numbering is for comparison with similar tests in
+# safe.test.
+#
+# Sourcing this file into tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# The defunct package http 1.0 was convenient for testing package loading.
+# - This file, safe-stock.test, uses packages opt and (from cookiejar)
+# tcl::idna to provide alternative tests based on stock Tcl packages.
+# - These are tests 7.1 7.2 7.4 9.11 9.13
+# - Tests 7.[124], 9.1[13] use "package require opt".
+# - Tests 9.1[13] also use "package require tcl::idna".
+# - The corresponding tests in safe.test use example packages provided in
+# subdirectory auto0 of the tests directory, which are independent of any
+# changes made to the packages provided with Tcl.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
+
+foreach i [interp children] {
+ interp delete $i
+}
+
+# When using package opt for testing positive/negative package search:
+# - The directory location and the error message depend on whether
+# and how the package is installed.
+
+# Error message for test 7.2 for "package require opt".
+if {[string match *zipfs:/* [info library]]} {
+ # pkgIndex.tcl is in [info library]
+ # file to be sourced is in [info library]/opt*
+ set pkgOptErrMsg {permission denied}
+} else {
+ # pkgIndex.tcl and file to be sourced are
+ # both in [info library]/opt*
+ set pkgOptErrMsg {can't find package opt}
+}
+
+# Directory of opt for tests 7.4, 9.10, 9.12 for "package require opt".
+if {[file exists [file join [info library] opt0.4]]} {
+ # Installed files in lib8.7/opt0.4
+ set pkgOptDir opt0.4
+} elseif {[file exists [file join [info library] opt]]} {
+ # Installed files in zipfs, or source files used by "make test"
+ set pkgOptDir opt
+} else {
+ error {cannot find opt library}
+}
+
+# Directory of cookiejar for tests 9.10, 9.12 for "package require tcl::idna".
+if {[file exists [file join [info library] cookiejar0.2]]} {
+ # Installed files in lib8.7/cookiejar0.2
+ set pkgJarDir cookiejar0.2
+} elseif {[file exists [file join [info library] cookiejar]]} {
+ # Installed files in zipfs, or source files used by "make test"
+ set pkgJarDir cookiejar
+} else {
+ error {cannot find cookiejar library}
+}
+
+set SaveAutoPath $::auto_path
+set ::auto_path [info library]
+set TestsDir [file normalize [file dirname [info script]]]
+set PathMapp {}
+lappend PathMapp [file join [info library] $pkgOptDir] TCLLIB/OPTDIR
+lappend PathMapp [file join [info library] $pkgJarDir] TCLLIB/JARDIR
+lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR
+
+proc mapList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ return $listOut
+}
+proc mapAndSortList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ lsort $listOut
+}
+
+# Force actual loading of the safe package because we use un-exported (and
+# thus un-autoindexed) APIs in this test result arguments:
+catch {safe::interpConfigure}
+
+# high level general test
+test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -setup {
+ set i [safe::interpCreate]
+} -body {
+ # no error shall occur:
+ # (because the default access_path shall include 1st level sub dirs so
+ # package require in a child works like in the parent)
+ set v [interp eval $i {package require opt}]
+ # no error shall occur:
+ interp eval $i {::tcl::Lempty {a list}}
+ set v
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result 0.4.*
+test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pkg opt} -setup {
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
+ # an error shall occur (opt is not anymore in the secure 0-level
+ # provided deep path)
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ list $token1 $token2 -- \
+ [catch {interp eval $i {package require opt}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+} -cleanup {
+} -match glob -result "{\$p(:0:)} {\$p(:*:)} -- 1 {$pkgOptErrMsg} --\
+ {TCLLIB */dummy/unixlike/test/path} -- {}"
+test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -setup {
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # this time, unlike test safe-stock-7.2, opt should be found
+ list $token1 $token2 -- \
+ [catch {interp eval $i {package require opt}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+ # Note that the glob match elides directories (those from the module path)
+ # other than the first and last in the access path.
+} -cleanup {
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\
+ {TCLLIB * TCLLIB/OPTDIR} -- {}}
+
+# The following test checks whether the definition of tcl_endOfWord can be
+# obtained from auto_loading. It was previously test "safe-5.1".
+test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setup {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+} -body {
+ interp eval a {tcl_endOfWord "" 0}
+} -cleanup {
+ safe::interpDelete a
+} -result -1
+test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $tcl_library $pkgOptDir] \
+ [file join $tcl_library $pkgJarDir]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ # This has no effect because the records in Pkg of these directories were from access as children of {$p(:0:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $tcl_library $pkgJarDir] \
+ [file join $tcl_library $pkgOptDir]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require tcl::idna}} msg3]
+ set code4 [catch {interp eval $i {package require opt}} msg4]
+ set code5 [catch {interp eval $i {::tcl::Lempty {a list}}} msg5]
+ set code6 [catch {interp eval $i {::tcl::idna::IDNAencode example.com}} msg6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.* 0 0.4.* --\
+ {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} --\
+ {TCLLIB TCLLIB/JARDIR TCLLIB/OPTDIR*} --\
+ 0 0 0 example.com}
+test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, uses pkg opt and tcl::idna} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $tcl_library $pkgOptDir] \
+ [file join $tcl_library $pkgJarDir]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library]
+
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set code4 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]} path4]
+ set code5 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]} path5]
+
+ # Try to load the packages.
+ set code3 [catch {interp eval $i {package require opt}} msg3]
+ set code6 [catch {interp eval $i {package require tcl::idna}} msg6]
+
+ list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
+ $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
+ 1 {* not found in access path} -- 1 1 --\
+ {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} -- {TCLLIB*}}
+
+set ::auto_path $SaveAutoPath
+unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp
+rename mapList {}
+rename mapAndSortList {}
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/safe-zipfs.test b/tests/safe-zipfs.test
new file mode 100644
index 0000000..73703e4
--- /dev/null
+++ b/tests/safe-zipfs.test
@@ -0,0 +1,729 @@
+# safe-zipfs.test --
+#
+# This file contains tests for safe Tcl that test its compatibility with the
+# zipfs facilities introduced in Tcl 8.7. Test numbering is for comparison
+# with similar tests in safe.test that do not use the zipfs file system.
+#
+# Sourcing this file into tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.5-
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
+
+foreach i [interp children] {
+ interp delete $i
+}
+
+set SaveAutoPath $::auto_path
+set ::auto_path [info library]
+set TestsDir [file normalize [file dirname [info script]]]
+
+set ZipMountPoint [zipfs root]auto-files
+zipfs mount $ZipMountPoint [file join $TestsDir auto-files.zip]
+
+set PathMapp {}
+lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR $ZipMountPoint ZIPDIR
+
+proc mapList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ return $listOut
+}
+proc mapAndSortList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ lsort $listOut
+}
+
+# Force actual loading of the safe package because we use un-exported (and
+# thus un-autoindexed) APIs in this test result arguments:
+catch {safe::interpConfigure}
+
+# testing that nested and statics do what is advertised (we use a static
+# package - Tcltest - but it might be absent if we're in standard tclsh)
+
+testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
+
+# Tests 5.* test the example files before using them to test safe interpreters.
+
+test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]
+} -body {
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
+} -cleanup {
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {0 ok1 0 ok2}
+test safe-zipfs-5.2 {example tclIndex commands, negative test in parent interpreter; zipfs} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $ZipMountPoint auto0]
+} -body {
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
+} -cleanup {
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
+test safe-zipfs-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories; zipfs} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $ZipMountPoint auto0]
+} -body {
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {package require SafeTestPackage1} msg3]
+ set code4 [catch {package require SafeTestPackage2} msg4]
+ set code5 [catch HeresPackage1 msg5]
+ set code6 [catch HeresPackage2 msg6]
+ list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
+} -cleanup {
+ set ::auto_path $tmpAutoPath
+ catch {package forget SafeTestPackage1}
+ catch {package forget SafeTestPackage2}
+ catch {rename HeresPackage1 {}}
+ catch {rename HeresPackage2 {}}
+} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
+test safe-zipfs-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories; zipfs} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]
+} -body {
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {package require SafeTestPackage1} msg3]
+ set code4 [catch {package require SafeTestPackage2} msg4]
+ set code5 [catch HeresPackage1 msg5]
+ set code6 [catch HeresPackage2 msg6]
+ list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
+} -cleanup {
+ set ::auto_path $tmpAutoPath
+ catch {package forget SafeTestPackage1}
+ catch {package forget SafeTestPackage2}
+ catch {rename HeresPackage1 {}}
+ catch {rename HeresPackage2 {}}
+} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
+test safe-zipfs-5.5 {example modules packages, test in parent interpreter, replace path; zipfs} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ # Try to load the modules and run a command from each one.
+ set code0 [catch {package require test0} msg0]
+ set code1 [catch {package require mod1::test1} msg1]
+ set code2 [catch {package require mod2::test2} msg2]
+ set out0 [test0::try0]
+ set out1 [mod1::test1::try1]
+ set out2 [mod2::test2::try2]
+ list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ catch {package forget test0}
+ catch {package forget mod1::test1}
+ catch {package forget mod2::test2}
+ catch {namespace delete ::test0}
+ catch {namespace delete ::mod1}
+} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
+test safe-zipfs-5.6 {example modules packages, test in parent interpreter, append to path; zipfs} -setup {
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ # Try to load the modules and run a command from each one.
+ set code0 [catch {package require test0} msg0]
+ set code1 [catch {package require mod1::test1} msg1]
+ set code2 [catch {package require mod2::test2} msg2]
+ set out0 [test0::try0]
+ set out1 [mod1::test1::try1]
+ set out2 [mod2::test2::try2]
+ list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ catch {package forget test0}
+ catch {package forget mod1::test1}
+ catch {package forget mod2::test2}
+ catch {namespace delete ::test0}
+ catch {namespace delete ::mod1}
+} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
+
+# high level general test
+# Use zipped example packages not http1.0 etc
+test safe-zipfs-7.1 {tests that everything works at high level; zipfs} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $ZipMountPoint auto0]
+ set i [safe::interpCreate]
+ set ::auto_path $tmpAutoPath
+} -body {
+ # no error shall occur:
+ # (because the default access_path shall include 1st level sub dirs so
+ # package require in a child works like in the parent)
+ set v [interp eval $i {package require SafeTestPackage1}]
+ # no error shall occur:
+ interp eval $i {HeresPackage1}
+ set v
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result 1.2.3
+test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath; zipfs} -setup {
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
+ # should add as p* (not p2 if parent has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
+ # provided deep path)
+ list $token1 $token2 $token3 -- \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+} -cleanup {
+} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
+ 1 {can't find package SafeTestPackage1} --\
+ {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
+test safe-zipfs-7.4 {tests specific path and positive search; zipfs} -setup {
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # this time, unlike test safe-zipfs-7.2, SafeTestPackage1 should be found
+ list $token1 $token2 -- \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+ # Note that the glob match elides directories (those from the module path)
+ # other than the first and last in the access path.
+} -cleanup {
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
+ {TCLLIB * ZIPDIR/auto0/auto1} -- {}}
+
+test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset); zipfs} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Load auto_load data.
+ interp eval $i {catch nonExistentCommand}
+
+ # Load and run the commands.
+ # This guarantees the test will pass even if the tokens are swapped.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto2] \
+ [file join $ZipMountPoint auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Run the commands.
+ set code3 [catch {interp eval $i {report1}} msg3]
+ set code4 [catch {interp eval $i {report2}} msg4]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
+ {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
+test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset); zipfs} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Load auto_load data.
+ interp eval $i {catch nonExistentCommand}
+
+ # Do not load the commands. With the tokens swapped, the test
+ # will pass only if the Safe Base has called auto_reset.
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto2] \
+ [file join $ZipMountPoint auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Load and run the commands.
+ set code3 [catch {interp eval $i {report1}} msg3]
+ set code4 [catch {interp eval $i {report2}} msg4]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
+ 0 ok1 0 ok2 --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
+ {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
+test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement; zipfs} -setup {
+} -body {
+ # For complete correspondence to safe-stock87-9.11, include auto0 in access path.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0] \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
+ # This would have no effect because the records in Pkg of these directories
+ # were from access as children of {$p(:1:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0] \
+ [file join $ZipMountPoint auto0 auto2] \
+ [file join $ZipMountPoint auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
+ {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
+ 0 OK1 0 OK2}
+test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0; zipfs} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto2] \
+ [file join $ZipMountPoint auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
+ 0 1.2.3 0 2.3.4 --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
+ {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
+ 0 OK1 0 OK2}
+test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed; zipfs} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library]
+
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set code4 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]} path4]
+ set code5 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]} path5]
+
+ # Try to load the packages.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
+ set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
+
+ list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
+ $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
+ 1 {* not found in access path} -- 1 1 --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}}
+test safe-zipfs-9.20 {check module loading; zipfs} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
+ ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
+# - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
+# tokenized form to the child's access path, and then adds all the
+# descendants, discovered recursively by using glob.
+# - The order of the directories in the list returned by glob is system-dependent,
+# and therefore this is true also for (a) the order of token assignment to
+# descendants of the [tcl::tm::list] roots; and (b) the order of those same
+# directories in the access path. Both those things must be sorted before
+# comparing with expected results. The test is therefore not totally strict,
+# but will notice missing or surplus directories.
+test safe-zipfs-9.21 {interpConfigure change the access path; check module loading; stale data case 1; zipfs} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Load pkg data.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
+ ZIPDIR/auto0/modules/mod2} --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
+ ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-zipfs-9.20.
+test safe-zipfs-9.22 {interpConfigure change the access path; check module loading; stale data case 0; zipfs} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
+ ZIPDIR/auto0/modules/mod2} --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
+ ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-zipfs-9.20.
+test safe-zipfs-9.23 {interpConfigure change the access path; check module loading; stale data case 3; zipfs} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Force the interpreter to acquire pkg data which will soon become stale.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Refresh stale pkg data.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
+ ZIPDIR/auto0/modules/mod2} --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
+ ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-zipfs-9.20.
+test safe-zipfs-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case); zipfs} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $ZipMountPoint auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Force the interpreter to acquire pkg data which will soon become stale.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $ZipMountPoint auto0 auto1] \
+ [file join $ZipMountPoint auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
+ ZIPDIR/auto0/modules/mod2} --\
+ {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
+ ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-zipfs-9.20.
+
+# cleanup
+set ::auto_path $SaveAutoPath
+zipfs unmount ${ZipMountPoint}
+unset SaveAutoPath TestsDir ZipMountPoint PathMapp
+rename mapList {}
+rename mapAndSortList {}
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/safe.test b/tests/safe.test
index 356e176..ebaedabe 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -4,27 +4,52 @@
# using safe interpreters. Sourcing this file into tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
+# The defunct package http 1.0 was convenient for testing package loading.
+# - Tests that used http are replaced here with tests that use example packages
+# provided in subdirectory auto0 of the tests directory, which are independent
+# of any changes made to the packages provided with Tcl itself.
+# - These are tests 7.1 7.2 7.4 9.11 9.13
+# - Tests 5.* test the example packages themselves before they
+# are used to test Safe Base interpreters.
+# - Alternative tests using stock packages of Tcl 8.7 are in file
+# safe-stock87.test.
+#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require Tcl 8.5-
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
-foreach i [interp slaves] {
+foreach i [interp children] {
interp delete $i
}
-set saveAutoPath $::auto_path
+set SaveAutoPath $::auto_path
set ::auto_path [info library]
+set TestsDir [file normalize [file dirname [info script]]]
+set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]
+
+proc mapList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ return $listOut
+}
+proc mapAndSortList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ lsort $listOut
+}
-# Force actual loading of the safe package because we use un exported (and
+# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}
@@ -35,16 +60,16 @@ testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
safe::interpConfigure
-} -result {no value given for parameter "slave" (use -help for full usage) :
- slave name () name of the slave}
+} -result {no value given for parameter "child" (use -help for full usage) :
+ child name () name of the child}
test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
safe::interpCreate -help
} -result {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
(-help gives this help)
- ?slave? name () name of the slave (optional)
- -accessPath list () access path for the slave
+ ?child? name () name of the child (optional)
+ -accessPath list () access path for the child
-noStatics boolflag (false) prevent loading of statically linked pkgs
-statics boolean (true) loading of statically linked pkgs
-nestedLoadOk boolflag (false) allow nested loading
@@ -53,7 +78,7 @@ test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
safe::interpInit -noStatics
} -result {bad value "-noStatics" for parameter
- slave name () name of the slave}
+ child name () name of the child}
test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
# Disabled this test. It tests nothing sensible. [Bug 999612]
@@ -66,6 +91,8 @@ test safe-2.2 {creating interpreters, should have no aliases} -setup {
a aliases
} -cleanup {
safe::interpDelete a
+ # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
+ # is regrettable and should be removed at the next major revision.
} -result ""
test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup {
catch {safe::interpDelete a}
@@ -115,6 +142,8 @@ test safe-4.1 {safe::interpDelete} -setup {
} -body {
interp create a
safe::interpDelete a
+ # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
+ # is regrettable and should be removed at the next major revision.
} -result ""
test safe-4.2 {safe::interpDelete, indirectly} -setup {
catch {safe::interpDelete a}
@@ -122,6 +151,8 @@ test safe-4.2 {safe::interpDelete, indirectly} -setup {
interp create a
a alias exit safe::interpDelete a
a eval exit
+ # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
+ # is regrettable and should be removed at the next major revision.
} -result ""
test safe-4.5 {safe::interpDelete} -setup {
catch {safe::interpDelete a}
@@ -138,17 +169,118 @@ test safe-4.6 {safe::interpDelete, indirectly} -setup {
a eval exit
} -result ""
-# The following test checks whether the definition of tcl_endOfWord can be
-# obtained from auto_loading.
+# The old test "safe-5.1" has been moved to "safe-stock87-9.8".
+# A replacement test using example files is "safe-9.8".
+# Tests 5.* test the example files before using them to test safe interpreters.
-test safe-5.1 {test auto-loading in safe interpreters} -setup {
- catch {safe::interpDelete a}
- safe::interpCreate a
+test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2]
} -body {
- interp eval a {tcl_endOfWord "" 0}
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
} -cleanup {
- safe::interpDelete a
-} -result -1
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {0 ok1 0 ok2}
+test safe-5.2 {example tclIndex commands, negative test in parent interpreter} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0]
+} -body {
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
+} -cleanup {
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
+test safe-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0]
+} -body {
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {package require SafeTestPackage1} msg3]
+ set code4 [catch {package require SafeTestPackage2} msg4]
+ set code5 [catch HeresPackage1 msg5]
+ set code6 [catch HeresPackage2 msg6]
+ list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
+} -cleanup {
+ set ::auto_path $tmpAutoPath
+ catch {package forget SafeTestPackage1}
+ catch {package forget SafeTestPackage2}
+ catch {rename HeresPackage1 {}}
+ catch {rename HeresPackage2 {}}
+} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
+test safe-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]
+} -body {
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {package require SafeTestPackage1} msg3]
+ set code4 [catch {package require SafeTestPackage2} msg4]
+ set code5 [catch HeresPackage1 msg5]
+ set code6 [catch HeresPackage2 msg6]
+ list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
+} -cleanup {
+ set ::auto_path $tmpAutoPath
+ catch {package forget SafeTestPackage1}
+ catch {package forget SafeTestPackage2}
+ catch {rename HeresPackage1 {}}
+ catch {rename HeresPackage2 {}}
+} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
+test safe-5.5 {example modules packages, test in parent interpreter, replace path} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ # Try to load the modules and run a command from each one.
+ set code0 [catch {package require test0} msg0]
+ set code1 [catch {package require mod1::test1} msg1]
+ set code2 [catch {package require mod2::test2} msg2]
+ set out0 [test0::try0]
+ set out1 [mod1::test1::try1]
+ set out2 [mod2::test2::try2]
+ list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ catch {package forget test0}
+ catch {package forget mod1::test1}
+ catch {package forget mod2::test2}
+ catch {namespace delete ::test0}
+ catch {namespace delete ::mod1}
+} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
+test safe-5.6 {example modules packages, test in parent interpreter, append to path} -setup {
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ # Try to load the modules and run a command from each one.
+ set code0 [catch {package require test0} msg0]
+ set code1 [catch {package require mod1::test1} msg1]
+ set code2 [catch {package require mod2::test2} msg2]
+ set out0 [test0::try0]
+ set out1 [mod1::test1::try1]
+ set out2 [mod2::test2::try2]
+ list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ catch {package forget test0}
+ catch {package forget mod1::test1}
+ catch {package forget mod2::test2}
+ catch {namespace delete ::test0}
+ catch {namespace delete ::mod1}
+} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
# test safe interps 'information leak'
proc SafeEval {script} {
@@ -176,59 +308,121 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
lsort $r
} {byteOrder engine pathSeparator platform pointerSize wordSize}
+rename SafeEval {}
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
# high level general test
-test safe-7.1 {tests that everything works at high level} -body {
+# Use example packages not http1.0 etc
+test safe-7.1 {tests that everything works at high level} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0]
set i [safe::interpCreate]
+ set ::auto_path $tmpAutoPath
+} -body {
# no error shall occur:
# (because the default access_path shall include 1st level sub dirs so
- # package require in a slave works like in the master)
- set v [interp eval $i {package require http 2}]
+ # package require in a child works like in the parent)
+ set v [interp eval $i {package require SafeTestPackage1}]
# no error shall occur:
- interp eval $i {http::config}
- safe::interpDelete $i
+ interp eval $i {HeresPackage1}
set v
-} -match glob -result 2.*
-test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result 1.2.3
+test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup {
+} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
set token1 [safe::interpAddToAccessPath $i [info library]]
- # should add as p1
+ # should add as p* (not p1 if parent has a module path)
set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
- # an error shall occur (http is not anymore in the secure 0-level
+ # should add as p* (not p2 if parent has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
# provided deep path)
- list $token1 $token2 \
- [catch {interp eval $i {package require http 1}} msg] $msg \
- [safe::interpConfigure $i]\
- [safe::interpDelete $i]
-} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
+ list $token1 $token2 $token3 -- \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+} -cleanup {
+} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
+ 1 {can't find package SafeTestPackage1} --\
+ {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}}
test safe-7.3 {check that safe subinterpreters work} {
+ set g [interp children]
+ if {$g ne {}} {
+ append g { -- residue of an earlier test}
+ }
+ set h [info vars ::safe::S*]
+ if {$h ne {}} {
+ append h { -- residue of an earlier test}
+ }
set i [safe::interpCreate]
set j [safe::interpCreate [list $i x]]
- list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j]
-} {ok {} 0}
+ list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] \
+ [interp exists $j] [info vars ::safe::S*]
+} {{} {} ok {} 0 {}}
+test safe-7.3.1 {check that safe subinterpreters work with namespace names} -setup {
+} -body {
+ set g [interp children]
+ if {$g ne {}} {
+ append g { -- residue of an earlier test}
+ }
+ set h [info vars ::safe::S*]
+ if {$h ne {}} {
+ append h { -- residue of an earlier test}
+ }
+ set i [safe::interpCreate foo::bar]
+ set j [safe::interpCreate [list $i hello::world]]
+ list $g $h [interp eval $j {join {o k} ""}] \
+ [foo::bar eval {hello::world eval {join {o k} ""}}] \
+ [safe::interpDelete $i] \
+ [interp exists $j] [info vars ::safe::S*]
+} -match glob -result {{} {} ok ok {} 0 {}}
+test safe-7.4 {tests specific path and positive search} -setup {
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # this time, unlike test safe-7.2, SafeTestPackage1 should be found
+ list $token1 $token2 -- \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+ # Note that the glob match elides directories (those from the module path)
+ # other than the first and last in the access path.
+} -cleanup {
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
+ {TCLLIB * TESTSDIR/auto0/auto1} -- {}}
# test source control on file name
-set i "a"
test safe-8.1 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
$i eval {source}
} -returnCodes error -cleanup {
safe::interpDelete $i
+ unset i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.2 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
$i eval {source a b c d e}
} -returnCodes error -cleanup {
safe::interpDelete $i
+ unset i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.3 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {lappend ::log $str}
@@ -239,10 +433,12 @@ test safe-8.3 {safe source control on file} -setup {
list [catch {$i eval {source .}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
-} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
+ rename safe-test-log {}
+ unset i log
+} -result {1 {permission denied} {{ERROR for child a : ".": is a directory}}}
test safe-8.4 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -253,10 +449,12 @@ test safe-8.4 {safe source control on file} -setup {
list [catch {$i eval {source /abc/def}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
-} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
+ rename safe-test-log {}
+ unset i log
+} -result {1 {permission denied} {{ERROR for child a : "/abc/def": not in access_path}}}
test safe-8.5 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -271,10 +469,12 @@ test safe-8.5 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
-} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
+ rename safe-test-log {}
+ unset i log
+} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah]:no such file or directory"]]
test safe-8.6 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -287,10 +487,12 @@ test safe-8.6 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
-} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
+ rename safe-test-log {}
+ unset i log
+} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah.tcl]:no such file or directory"]]
test safe-8.7 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -305,14 +507,16 @@ test safe-8.7 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
-} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
+ rename safe-test-log {}
+ unset i log
+} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} emptyTest {
# Disabled this test. It was only useful for long unsupported
# Mac OS 9 systems. [Bug 860a9f1945]
} {}
test safe-8.9 {safe source and return} -setup {
+ set i "a"
set returnScript [makeFile {return "ok"} return.tcl]
catch {safe::interpDelete $i}
} -body {
@@ -322,8 +526,10 @@ test safe-8.9 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
test safe-8.10 {safe source and return} -setup {
+ set i "a"
set returnScript [makeFile {return -level 2 "ok"} return.tcl]
catch {safe::interpDelete $i}
} -body {
@@ -336,10 +542,11 @@ test safe-8.10 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
-set i "a"
test safe-9.1 {safe interps' deleteHook} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set res {}
} -body {
@@ -352,8 +559,12 @@ test safe-9.1 {safe interps' deleteHook} -setup {
}
safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
list [interp eval $i exit] $res
+} -cleanup {
+ catch {rename testDelHook {}}
+ unset i res
} -result {{} {arg1 arg2 a}}
test safe-9.2 {safe interps' error in deleteHook} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set res {}
set log {}
@@ -374,8 +585,10 @@ test safe-9.2 {safe interps' error in deleteHook} -setup {
list [safe::interpDelete $i] $res $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
-} -result {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}}
+ catch {rename testDelHook {}}
+ rename safe-test-log {}
+ unset i log res
+} -result {{} {arg1 arg2 a} {{NOTICE for child a : About to delete} {ERROR for child a : Delete hook error (being catched)} {NOTICE for child a : Deleted}}}
test safe-9.3 {dual specification of statics} -returnCodes error -body {
safe::interpCreate -stat true -nostat
} -result {conflicting values given for -statics and -noStatics}
@@ -403,7 +616,546 @@ test safe-9.6 {interpConfigure widget like behaviour} -body {
safe::interpConfigure $i]\
[safe::interpConfigure $i -deleteHook toto -nosta -nested 0
safe::interpConfigure $i]
-} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
+ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
+test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body {
+ # this test shall work, believed equivalent to 9.6
+ set i [safe::interpCreate \
+ -noStatics \
+ -nestedLoadOk \
+ -deleteHook {foo bar}]
+ safe::interpConfigure $i -accessPath /foo/bar
+ set a [safe::interpConfigure $i]
+ set b [safe::interpConfigure $i -aCCess]
+ set c [safe::interpConfigure $i -nested]
+ set d [safe::interpConfigure $i -statics]
+ set e [safe::interpConfigure $i -DEL]
+ safe::interpConfigure $i -accessPath /blah -statics 1
+ set f [safe::interpConfigure $i]
+ safe::interpConfigure $i -deleteHook toto -nosta -nested 0
+ set g [safe::interpConfigure $i]
+
+ list $a $b $c $d $e $f $g
+} -cleanup {
+ safe::interpDelete $i
+ unset -nocomplain a b c d e f g i
+} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
+ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
+test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load and run the commands.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}}
+test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load auto_load data.
+ interp eval $i {catch nonExistentCommand}
+
+ # Load and run the commands.
+ # This guarantees the test will pass even if the tokens are swapped.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Run the commands.
+ set code3 [catch {interp eval $i {report1}} msg3]
+ set code4 [catch {interp eval $i {report2}} msg4]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
+test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load auto_load data.
+ interp eval $i {catch nonExistentCommand}
+
+ # Do not load the commands. With the tokens swapped, the test
+ # will pass only if the Safe Base has called auto_reset.
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load and run the commands.
+ set code3 [catch {interp eval $i {report1}} msg3]
+ set code4 [catch {interp eval $i {report2}} msg4]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
+ 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
+test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup {
+} -body {
+ # For complete correspondence to safe-9.10opt, include auto0 in access path.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
+ # This would have no effect because the records in Pkg of these directories
+ # were from access as children of {$p(:1:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
+ 0 OK1 0 OK2}
+test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- \
+ $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
+ 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
+ 0 OK1 0 OK2}
+test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup {
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library]
+
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4]
+ set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5]
+
+ # Try to load the packages.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
+ set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
+
+ list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
+ $mappA -- $mappB
+} -cleanup {
+ safe::interpDelete $i
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
+ 1 {* not found in access path} -- 1 1 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}}
+test safe-9.20 {check module loading} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} -- res0 res1 res2}
+# - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
+# tokenized form to the child's access path, and then adds all the
+# descendants, discovered recursively by using glob.
+# - The order of the directories in the list returned by glob is system-dependent,
+# and therefore this is true also for (a) the order of token assignment to
+# descendants of the [tcl::tm::list] roots; and (b) the order of those same
+# directories in the access path. Both those things must be sorted before
+# comparing with expected results. The test is therefore not totally strict,
+# but will notice missing or surplus directories.
+test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Load pkg data.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Force the interpreter to acquire pkg data which will soon become stale.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Refresh stale pkg data.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Force the interpreter to acquire pkg data which will soon become stale.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
catch {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
@@ -412,7 +1164,7 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
set i [safe::interpCreate]
} -body {
@@ -421,7 +1173,7 @@ test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
} -returnCodes ok -cleanup {
unset -nocomplain m o
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
invoked from within
"load {} Safepkg1"
invoked from within
@@ -444,7 +1196,7 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl
interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
set i [safe::interpCreate -nestedloadok]
catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
@@ -452,7 +1204,7 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints T
} -returnCodes ok -cleanup {
unset -nocomplain m o
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
invoked from within
"load {} Safepkg1 x"
invoked from within
@@ -608,6 +1360,15 @@ proc buildEnvironment {filename} {
set testdir2 [makeDirectory deletemetoo $testdir]
set testfile [makeFile {} $filename $testdir2]
}
+proc buildEnvironment2 {filename} {
+ upvar 1 testdir testdir testdir2 testdir2 testfile testfile
+ upvar 1 testdir3 testdir3 testfile2 testfile2
+ set testdir [makeDirectory deletethisdir]
+ set testdir2 [makeDirectory deletemetoo $testdir]
+ set testfile [makeFile {} $filename $testdir2]
+ set testdir3 [makeDirectory deleteme $testdir]
+ set testfile2 [makeFile {} $filename $testdir3]
+}
#### New tests for Safe base glob, with patches @ Bug 2964715
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
set i [safe::interpCreate]
@@ -679,21 +1440,33 @@ test safe-13.6 {as 13.4 but test silent failure when result is outside access_pa
safe::interpDelete $i
removeDirectory $testdir
} -result {}
-test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup {
+test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug 2964715]} -setup {
set i [safe::interpCreate]
buildEnvironment pkgIndex.tcl
} -body {
set safeTD [::safe::interpAddToAccessPath $i $testdir]
::safe::interpAddToAccessPath $i $testdir2
- string map [list $safeTD EXPECTED] [$i eval [list \
+ mapList [list $safeTD EXPECTED] [$i eval [list \
+ glob -directory $safeTD -join * pkgIndex.tcl]]
+} -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {EXPECTED/deletemetoo/pkgIndex.tcl}
+test safe-13.7.1 {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment2 pkgIndex.tcl
+} -body {
+ set safeTD [::safe::interpAddToAccessPath $i $testdir]
+ ::safe::interpAddToAccessPath $i $testdir2
+ ::safe::interpAddToAccessPath $i $testdir3
+ mapAndSortList [list $safeTD EXPECTED] [$i eval [list \
glob -directory $safeTD -join * pkgIndex.tcl]]
} -cleanup {
safe::interpDelete $i
removeDirectory $testdir
-} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}}
-# Note the extra {} around the result above; that's *expected* because of the
-# format of virtual path roots.
-test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
+} -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl}
+# See comments on lsort after test safe-9.20.
+test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
set i [safe::interpCreate]
buildEnvironment notIndex.tcl
} -body {
@@ -731,9 +1504,10 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p
removeDirectory $testdir
} -result {}
rename buildEnvironment {}
+rename buildEnvironment2 {}
#### Test for the module path
-test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
+test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
set tm {}
@@ -795,6 +1569,7 @@ test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
} -cleanup {
safe::interpDelete $i
set env(HOME) $savedHOME
+ unset savedHOME
} -result {./~}
test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
set i [safe::interpCreate]
@@ -804,6 +1579,7 @@ test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
"file join \[file dirname ~$user\] \[file tail ~$user\]"]
} -cleanup {
safe::interpDelete $i
+ unset user
} -result {./~USER}
test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
set syntheticHOME [makeDirectory foo]
@@ -818,6 +1594,7 @@ test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
safe::interpDelete $i
set env(HOME) $savedHOME
removeDirectory $syntheticHOME
+ unset savedHOME syntheticHOME
} -result {}
test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
set i [safe::interpCreate]
@@ -827,9 +1604,58 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
} -cleanup {
safe::interpDelete $i
} -result {}
+test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ file join {$p(:0:)} $d
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ unset savedHOME
+} -result {~}
+test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ file join {$p(:0:)/foo/bar} $d
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ unset savedHOME
+} -result {~}
+test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]]
+} -cleanup {
+ safe::interpDelete $i
+ unset user
+} -result {~USER}
+test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]]
+} -cleanup {
+ safe::interpDelete $i
+ unset user
+} -result {~USER}
-set ::auto_path $saveAutoPath
# cleanup
+set ::auto_path $SaveAutoPath
+unset SaveAutoPath TestsDir PathMapp
+rename mapList {}
+rename mapAndSortList {}
::tcltest::cleanupTests
return
diff --git a/tests/scan.test b/tests/scan.test
index b488f68..fe912db 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -555,6 +555,11 @@ test scan-5.19 {bigint scanning invalid} -setup {
list [scan "207698809136909011942886895" \
%llu a] $a
} -result {1 207698809136909011942886895}
+test scan-5.20 {ignore digit separators} -setup {
+ set a {}; set b {}; set c {};
+} -body {
+ list [scan "10_23_45" %d_%d_%d a b c] $a $b $c
+} -result {3 10 23 45}
test scan-6.1 {floating-point scanning} -setup {
set a {}; set b {}; set c {}; set d {}
@@ -600,6 +605,11 @@ test scan-6.8 {floating-point scanning} -setup {
} -body {
list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
} -result {2 4.6 5.2 {} {}}
+test scan-6.8 {disallow diget separator in floating-point} -setup {
+ set a {}; set b {}; set c {};
+} -body {
+ list [scan "3.14_2.35_98.6" %f_%f_%f a b c ] $a $b $c
+} -result {3 3.14 2.35 98.6}
test scan-7.1 {string and character scanning} -setup {
set a {}; set b {}; set c {}; set d {}
diff --git a/tests/security.test b/tests/security.test
index eeabc9c..3235a1f 100644
--- a/tests/security.test
+++ b/tests/security.test
@@ -11,7 +11,7 @@
# All rights reserved.
if {"::tcltest" ni [namespace children]} {
- package require tcltest
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/set-old.test b/tests/set-old.test
index ea5155b..e29b93b 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/set.test b/tests/set.test
index 3c87000..303c2d7 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/socket.test b/tests/socket.test
index fbaade9..868c17a 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -60,8 +60,8 @@
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -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"
@@ -291,6 +291,9 @@ proc getPort sock {
lindex [fconfigure $sock -sockname] 2
}
+# Some tests in this file are known to hang *occasionally* on OSX; stop the
+# worst offenders.
+testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# ----------------------------------------------------------------------
@@ -933,7 +936,7 @@ test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}
test socket_$af-5.2 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 0x10000} msg]} {
close $msg
@@ -947,7 +950,7 @@ test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}
test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup {
proc myHandler {msg options} {
@@ -1864,12 +1867,12 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
}
}
tcltest::DebugPuts 1 "== test \[$::localhost\]:$port $testmode =="
- set ::master [thread::id]
- # helper thread creating async connection and initiating transfer (detach) to master:
+ set ::parent [thread::id]
+ # helper thread creating async connection and initiating transfer (detach) to parent:
set ::helper [thread::create]
thread::send -async $::helper [list \
- lassign [list $::master $::localhost $port $testmode] \
- ::master ::localhost ::port ::testmode
+ lassign [list $::parent $::localhost $port $testmode] \
+ ::parent ::localhost ::port ::testmode
]
thread::send -async $::helper {
set ::helper [thread::id]
@@ -1878,29 +1881,29 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
if {"helper-writable" in $::testmode} {;# to test both sides during connect
fileevent $fd writable [list apply {{fd} {
if {[thread::id] ne $::helper} {
- thread::send -async $::master {set ::count "ERROR: invalid thread, $::helper is expecting"}
+ thread::send -async $::parent {set ::count "ERROR: invalid thread, $::helper is expecting"}
close $fd
return
}
}} $fd]
};#
thread::detach $fd
- thread::send -async $::master [list transf_master $fd {*}$args]
+ thread::send -async $::parent [list transf_parent $fd {*}$args]
}
iteration first
}
- # master proc commiting transfer attempt (attach) and checking acquire was successful:
- proc transf_master {fd args} {
+ # parent proc commiting transfer attempt (attach) and checking acquire was successful:
+ proc transf_parent {fd args} {
tcltest::DebugPuts 1 "** trma / $::count ** $args **"
thread::attach $fd
- if {"master-close" in $::testmode} {;# to test close during connect
+ if {"parent-close" in $::testmode} {;# to test close during connect
set ::count $::count
close $fd
return
};#
fileevent $fd writable [list apply {{fd} {
- if {[thread::id] ne $::master} {
- thread::send -async $::master {set ::count "ERROR: invalid thread, $::master is expecting"}
+ if {[thread::id] ne $::parent} {
+ thread::send -async $::parent {set ::count "ERROR: invalid thread, $::parent is expecting"}
close $fd
return
}
@@ -1928,7 +1931,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
if {$srvsock ne {}} {close $srvsock}
if {[info exists ::helper]} {thread::release -wait $::helper}
tcltest::DebugPuts 1 "== stop / $::count =="
- unset -nocomplain ::count ::testmode ::master ::helper
+ unset -nocomplain ::count ::testmode ::parent ::helper
}
}
test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body {
@@ -1938,12 +1941,12 @@ test socket_$af-13.2.tr2 {Testing socket transfer between threads during async c
transf_test {transfer helper-writable} 100
} -result 100 -constraints [list socket supported_$af thread]
test socket_$af-13.2.cl1 {Testing socket transfer between threads during async connect} -body {
- transf_test {master-close} 100
+ transf_test {parent-close} 100
} -result 100 -constraints [list socket supported_$af thread]
test socket_$af-13.2.cl2 {Testing socket transfer between threads during async connect} -body {
- transf_test {master-close helper-writable} 100
+ transf_test {parent-close helper-writable} 100
} -result 100 -constraints [list socket supported_$af thread]
-catch {rename transf_master {}}
+catch {rename transf_parent {}}
rename transf_test {}
# ----------------------------------------------------------------------
diff --git a/tests/split.test b/tests/split.test
index d00c452..9c95b81 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/stack.test b/tests/stack.test
index 4c50f74..77cb69f 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -9,8 +9,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
# Note that a failure in this test may result in a crash of the executable.
diff --git a/tests/string.test b/tests/string.test
index 98890f9..a42aacc 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -31,7 +31,7 @@ proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
-testConstraint tip389 [expr {[string length \U010000] == 2}]
+testConstraint utf16 [expr {[string length \U010000] == 2}]
testConstraint testbytestring [llength [info commands testbytestring]]
# Used for constraining memory leak tests
@@ -506,7 +506,7 @@ test string-5.19.$noComp {string index, bytearray object out of bounds} {
test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
run {string index [binary format I* {0x50515253 0x52}] 20}
} -result {}
-test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints {tip389} -body {
+test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body {
run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} -result [list \U100000 {} b]
@@ -777,7 +777,7 @@ test string-6.80.$noComp {string is wordchar, true} {
run {string is wordchar abc_123}
} 1
test string-6.81.$noComp {string is wordchar, unicode true} {
- run {string is wordchar abc\xFCab\xDCAB\u5001}
+ run {string is wordchar abc\xFCab\xDCAB\u5001\U1D7CA}
} 1
test string-6.82.$noComp {string is wordchar, false} {
list [run {string is wordchar -fail var abcd.ef}] $var
@@ -1503,9 +1503,23 @@ test string-12.22.$noComp {string range, shimmering binary/index} {
binary scan $s a* x
run {string range $s $s end}
} 000000001
-test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} tip389 {
+test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf16 {
run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]}
} [list \U100000 {} b]
+test string-12.24.$noComp {bignum index arithmetic} -setup {
+ proc demo {i j} {string range fubar $i $j}
+} -cleanup {
+ rename demo {}
+} -body {
+ demo 2 0+0x10000000000000000
+} -result bar
+test string-12.25.$noComp {bignum index arithmetic} -setup {
+ proc demo {i j} {string range fubar $i $j}
+} -cleanup {
+ rename demo {}
+} -body {
+ demo 0x10000000000000000-0xffffffffffffffff 3
+} -result uba
test string-13.1.$noComp {string repeat} {
list [catch {run {string repeat}} msg] $msg
@@ -1651,6 +1665,9 @@ test stringComp-14.24.$noComp {Bug 1af8de570511} {
test stringComp-14.25.$noComp {} {
string length [string replace [string repeat a\xFE 2] 3 end {}]
} 3
+test stringComp-14.26.$noComp {} {
+ run {string replace abcd 0x10000000000000000-0xffffffffffffffff 2 e}
+} aed
test string-15.1.$noComp {string tolower too few args} {
list [catch {run {string tolower}} msg] $msg
@@ -1744,7 +1761,7 @@ test string-17.7.$noComp {string totitle, unicode} {
test string-17.8.$noComp {string totitle, compiled} {
lindex [run {string totitle [list aa bb [list cc]]}] 0
} Aa
-test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 {
+test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} utf16 {
run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
[string totitle a\U118c0c 3 3]}
} [list a\U118a0c a\U118c0C a\U118c0C]
@@ -1888,7 +1905,7 @@ test string-21.14.$noComp {string wordend, unicode} -body {
test string-21.15.$noComp {string wordend, unicode} -body {
run {string wordend "\U1D7CA\U1D7CA abc" 0}
} -result 2
-test string-21.16.$noComp {string wordend, unicode} -constraints tip389 -body {
+test string-21.16.$noComp {string wordend, unicode} -constraints utf16 -body {
run {string wordend "\U1D7CA\U1D7CA abc" 10}
} -result 8
@@ -1939,7 +1956,7 @@ test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbyt
test string-22.15.$noComp {string wordstart, unicode} -body {
run {string wordstart "\U1D7CA\U1D7CA abc" 0}
} -result 0
-test string-22.16.$noComp {string wordstart, unicode} -constraints tip389 -body {
+test string-22.16.$noComp {string wordstart, unicode} -constraints utf16 -body {
run {string wordstart "\U1D7CA\U1D7CA abc" 10}
} -result 5
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 3779bca..ca6c323 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -29,8 +29,8 @@ testConstraint nodep [info exists tcl_precision]
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/subst.test b/tests/subst.test
index 1f3c22a..42d1bec 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2.1
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
@@ -282,18 +282,18 @@ test subst-13.1 {Bug 3081065} -setup {
demo name2
} subst13.tcl]
} -body {
- interp create slave
- slave eval [list source $script]
- interp delete slave
- interp create slave
- slave eval {
+ interp create child
+ child eval [list source $script]
+ interp delete child
+ interp create child
+ child eval {
set count 400
while {[incr count -1]} {
lappend bloat [expr {rand()}]
}
}
- slave eval [list source $script]
- interp delete slave
+ child eval [list source $script]
+ interp delete child
} -cleanup {
removeFile subst13.tcl
}
diff --git a/tests/switch.test b/tests/switch.test
index 4d204bb..8ca049c 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/tailcall.test b/tests/tailcall.test
index 9174167..3704333 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/tcltest.test b/tests/tcltest.test
index c856209..b2debe7 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -13,13 +13,13 @@
# testing to run the test itself. Ditto on things like [verbose].
#
# It would be better to have the -body of the tests run the tcltest
-# commands in a slave interp so the [test] being tested would not
+# commands in a child interp so the [test] being tested would not
# interfere with the [test] doing the testing.
#
-if {[catch {package require tcltest 2.1}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
namespace eval ::tcltest::test {
@@ -27,7 +27,7 @@ namespace eval ::tcltest::test {
namespace import ::tcltest::*
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import ::tcltest::test
test a-1.0 {test a} {
list 0
@@ -63,11 +63,11 @@ test tcltest-1.3 {tcltest -h} {exec} {
} {1 0}
# -verbose, implicit & explicit testing of [verbose]
-proc slave {msgVar args} {
+proc child {msgVar args} {
upvar 1 $msgVar msg
interp create [namespace current]::i
- # Fake the slave interp into dumping output to a file
+ # Fake the child interp into dumping output to a file
i eval {namespace eval ::tcltest {}}
i eval "set tcltest::outputChannel\
\[[list open [set of [makeFile {} output]] w]]"
@@ -99,44 +99,44 @@ proc slave {msgVar args} {
return $code
}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} {
- set result [slave msg test.tcl]
+ set result [child msg test.tcl]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} {
- set result [slave msg test.tcl -verbose 'b']
+ set result [child msg test.tcl -verbose 'b']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} {
- set result [slave msg test.tcl -verbose 'p']
+ set result [child msg test.tcl -verbose 'p']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 0 1}
test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} {
- set result [slave msg test.tcl -verbose 's']
+ set result [child msg test.tcl -verbose 's']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 0 1 1}
test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} {
- set result [slave msg test.tcl -verbose 'ps']
+ set result [child msg test.tcl -verbose 'ps']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 1 1}
test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} {
- set result [slave msg test.tcl -verbose 'psb']
+ set result [child msg test.tcl -verbose 'psb']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
- set result [slave msg test.tcl -verbose "pass skip body"]
+ set result [child msg test.tcl -verbose "pass skip body"]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
@@ -145,7 +145,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
test tcltest-2.6 {tcltest -verbose 't'} {
-constraints {unixOrWin}
-body {
- set result [slave msg test.tcl -verbose 't']
+ set result [child msg test.tcl -verbose 't']
list $result $msg
}
-result {^0 .*a-1.0 start.*b-1.0 start}
@@ -155,7 +155,7 @@ test tcltest-2.6 {tcltest -verbose 't'} {
test tcltest-2.6a {tcltest -verbose 'start'} {
-constraints {unixOrWin}
-body {
- set result [slave msg test.tcl -verbose start]
+ set result [child msg test.tcl -verbose start]
list $result $msg
}
-result {^0 .*a-1.0 start.*b-1.0 start}
@@ -178,7 +178,7 @@ test tcltest-2.7 {tcltest::verbose} {
test tcltest-2.8 {tcltest -verbose 'error'} {
-constraints {unixOrWin}
-body {
- set result [slave msg test.tcl -verbose error]
+ set result [child msg test.tcl -verbose error]
list $result $msg
}
-result {errorInfo: foo.*errorCode: 9}
@@ -186,22 +186,22 @@ test tcltest-2.8 {tcltest -verbose 'error'} {
}
# -match, [match]
test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} {
- set result [slave msg test.tcl -match a* -verbose 'ps']
+ set result [child msg test.tcl -match a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} {
- set result [slave msg test.tcl -match b* -verbose 'ps']
+ set result [child msg test.tcl -match b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} {
- set result [slave msg test.tcl -match c* -verbose 'ps']
+ set result [child msg test.tcl -match c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} {
- set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
+ set result [child msg test.tcl -match {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 1 0 1}
@@ -221,27 +221,27 @@ test tcltest-3.5 {tcltest::match} {
# -skip, [skip]
test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} {
- set result [slave msg test.tcl -skip a* -verbose 'ps']
+ set result [child msg test.tcl -skip a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} {
- set result [slave msg test.tcl -skip b* -verbose 'ps']
+ set result [child msg test.tcl -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} {
- set result [slave msg test.tcl -skip c* -verbose 'ps']
+ set result [child msg test.tcl -skip c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} {
- set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
+ set result [child msg test.tcl -skip {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} {
- set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
+ set result [child msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
@@ -262,12 +262,12 @@ test tcltest-4.6 {tcltest::skip} {
# -constraints, -limitconstraints, [testConstraint],
# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} {
- set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
+ set result [child msg test.tcl -constraints knownBug -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} {
- set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
+ set result [child msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 0 0 1 1}
@@ -340,7 +340,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \
# -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile]
set printerror [makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import ::tcltest::*
puts [outputChannel] "a test"
::tcltest::PrintError "a really short string"
@@ -357,28 +357,28 @@ set printerror [makeFile {
test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
-constraints unixOrWin
-body {
- slave msg $printerror
+ child msg $printerror
return $msg
}
-result {a test.*a really}
-match regexp
}
test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} {
- slave msg $printerror -outfile a.tmp
+ child msg $printerror -outfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} {
- slave msg $printerror -errfile a.tmp
+ child msg $printerror -errfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {1 0 1 0 1 {}}
test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} {
- slave msg $printerror -outfile a.tmp -errfile b.tmp
+ child msg $printerror -outfile a.tmp -errfile b.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" b.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
@@ -463,7 +463,7 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} {
# -debug, [debug]
# Must use child processes to test -debug because it always writes
# messages to stdout, and we have no way to capture stdout of a
-# slave interp
+# child interp
test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 0} msg
regexp "Flags passed into tcltest" $msg
@@ -510,7 +510,7 @@ removeFile test.tcl
# directory tests
set a [makeFile {
- package require tcltest
+ package require tcltest 2.5
tcltest::makeFile {} a.tmp
puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]"
exit
@@ -525,7 +525,7 @@ normalizePath normaldirectory
test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
file delete -force thisdirectorydoesnotexist
} -body {
- slave msg $a -tmpdir thisdirectorydoesnotexist
+ child msg $a -tmpdir thisdirectorydoesnotexist
file exists [file join thisdirectorydoesnotexist a.tmp]
} -cleanup {
file delete -force thisdirectorydoesnotexist
@@ -533,7 +533,7 @@ test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
-constraints unixOrWin
-body {
- slave msg $a -tmpdir $tdiaf
+ child msg $a -tmpdir $tdiaf
return $msg
}
-result {*not a directory*}
@@ -558,7 +558,7 @@ switch -- $::tcl_platform(platform) {
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
-constraints {unix notRoot}
-body {
- slave msg $a -tmpdir $notReadableDir
+ child msg $a -tmpdir $notReadableDir
return $msg
}
-result {*not readable*}
@@ -574,7 +574,7 @@ testConstraint notFAT [expr {
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
-constraints {unixOrWin notRoot notFAT}
-body {
- slave msg $a -tmpdir $notWriteableDir
+ child msg $a -tmpdir $notWriteableDir
return $msg
}
-result {*not writeable*}
@@ -583,7 +583,7 @@ test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
-constraints unixOrWin
-body {
- slave msg $a -tmpdir $normaldirectory
+ child msg $a -tmpdir $normaldirectory
# The join is necessary because the message can be split on multiple
# lines
file exists [file join $normaldirectory a.tmp]
@@ -629,7 +629,7 @@ test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
file delete -force thisdirectorydoesnotexist
}
-body {
- slave msg $a -testdir thisdirectorydoesnotexist
+ child msg $a -testdir thisdirectorydoesnotexist
return $msg
}
-match glob
@@ -638,7 +638,7 @@ test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
-constraints unixOrWin
-body {
- slave msg $a -testdir $tdiaf
+ child msg $a -testdir $tdiaf
return $msg
}
-match glob
@@ -647,7 +647,7 @@ test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
-constraints {unix notRoot}
-body {
- slave msg $a -testdir $notReadableDir
+ child msg $a -testdir $notReadableDir
return $msg
}
-match glob
@@ -656,7 +656,7 @@ test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
-constraints unixOrWin
-body {
- slave msg $a -testdir $normaldirectory
+ child msg $a -testdir $normaldirectory
# The join is necessary because the message can be split on multiple
# lines
list [string first "testdir: $normaldirectory" [join $msg]] \
@@ -735,7 +735,7 @@ test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
set old [testsDirectory]
testsDirectory [file dirname [info script]]
} -body {
- slave msg [file join [testsDirectory] all.tcl] -file d*.test
+ child msg [file join [testsDirectory] all.tcl] -file d*.test
return $msg
} -cleanup {
testsDirectory $old
@@ -745,7 +745,7 @@ test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup {
set old [testsDirectory]
testsDirectory [file dirname [info script]]
} -body {
- slave msg [file join [testsDirectory] all.tcl] \
+ child msg [file join [testsDirectory] all.tcl] \
-file d*.test -notfile dstring*
regexp {dstring\.test} $msg
} -cleanup {
@@ -784,7 +784,7 @@ test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup {
makeFile {} fee $d
file copy [file join [file dirname [info script]] all.tcl] $d
} -body {
- slave msg [file join [temporaryDirectory] all.tcl] -file f*
+ child msg [file join [temporaryDirectory] all.tcl] -file f*
regexp {exiting with errors:} $msg
} -cleanup {
file delete [file join $d all.tcl]
@@ -795,7 +795,7 @@ test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup {
# -preservecore, [preserveCore]
set mc [makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import ::tcltest::test
test makecore {make a core file} {
set f [open core w]
@@ -807,23 +807,23 @@ set mc [makeFile {
cd [temporaryDirectory]
test tcltest-10.1 {-preservecore 0} {unixOrWin} {
- slave msg $mc -preservecore 0
+ child msg $mc -preservecore 0
file delete core
regexp "Core file produced" $msg
} {0}
test tcltest-10.2 {-preservecore 1} {unixOrWin} {
- slave msg $mc -preservecore 1
+ child msg $mc -preservecore 1
file delete core
regexp "Core file produced" $msg
} {1}
test tcltest-10.3 {-preservecore 2} {unixOrWin} {
- slave msg $mc -preservecore 2
+ child msg $mc -preservecore 2
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
test tcltest-10.4 {-preservecore 3} {unixOrWin} {
- slave msg $mc -preservecore 3
+ child msg $mc -preservecore 3
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
@@ -846,7 +846,7 @@ removeFile makecore.tcl
# -load, -loadfile, [loadScript], [loadFile]
set contents {
- package require tcltest
+ package require tcltest 2.5
namespace import tcltest::*
puts [outputChannel] $::tcltest::loadScript
exit
@@ -854,7 +854,7 @@ set contents {
set loadfile [makeFile $contents load.tcl]
test tcltest-12.1 {-load xxx} {unixOrWin} {
- slave msg $loadfile -load xxx
+ child msg $loadfile -load xxx
return $msg
} {xxx}
@@ -942,7 +942,7 @@ makeFile {
} single2.test $spd
set allfile [makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import tcltest::*
testsDirectory [file join [temporaryDirectory] singleprocdir]
runAllTests
@@ -952,7 +952,7 @@ cd [workingDirectory]
test tcltest-14.1 {-singleproc - single process} {
-constraints {unixOrWin}
-body {
- slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
+ child msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
return $msg
}
-result {Test file error: can't unset .foo.: no such variable}
@@ -962,7 +962,7 @@ test tcltest-14.1 {-singleproc - single process} {
test tcltest-14.2 {-singleproc - multiple process} {
-constraints {unixOrWin}
-body {
- slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
+ child msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
return $msg
}
-result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
@@ -999,25 +999,25 @@ set dtd1 [makeDirectory dirtestdir2.1 $dtd]
set dtd2 [makeDirectory dirtestdir2.2 $dtd]
set dtd3 [makeDirectory dirtestdir2.3 $dtd]
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import -force tcltest::*
testsDirectory [file join [temporaryDirectory] dirtestdir]
runAllTests
} all.tcl $dtd
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import -force tcltest::*
testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.1]
runAllTests
} all.tcl $dtd1
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import -force tcltest::*
testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.2]
runAllTests
} all.tcl $dtd2
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import -force tcltest::*
testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3]
runAllTests
@@ -1026,7 +1026,7 @@ makeFile {
test tcltest-15.1 {basic directory walking} {
-constraints {unixOrWin}
-body {
- if {[slave msg \
+ if {[child msg \
[file join $dtd all.tcl] \
-tmpdir [temporaryDirectory]] == 1} {
error $msg
@@ -1040,7 +1040,7 @@ test tcltest-15.1 {basic directory walking} {
test tcltest-15.2 {-asidefromdir} {
-constraints {unixOrWin}
-body {
- if {[slave msg \
+ if {[child msg \
[file join $dtd all.tcl] \
-asidefromdir dirtestdir2.3 \
-tmpdir [temporaryDirectory]] == 1} {
@@ -1058,7 +1058,7 @@ Error: No test files remain after applying your match and skip patterns!$}
test tcltest-15.3 {-relateddir, non-existent dir} {
-constraints {unixOrWin}
-body {
- if {[slave msg \
+ if {[child msg \
[file join $dtd all.tcl] \
-relateddir [file join [temporaryDirectory] dirtestdir0] \
-tmpdir [temporaryDirectory]] == 1} {
@@ -1073,7 +1073,7 @@ test tcltest-15.3 {-relateddir, non-existent dir} {
test tcltest-15.4 {-relateddir, subdir} {
-constraints {unixOrWin}
-body {
- if {[slave msg \
+ if {[child msg \
[file join $dtd all.tcl] \
-relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
error $msg
@@ -1086,7 +1086,7 @@ test tcltest-15.4 {-relateddir, subdir} {
test tcltest-15.5 {-relateddir, -asidefromdir} {
-constraints {unixOrWin}
-body {
- if {[slave msg \
+ if {[child msg \
[file join $dtd all.tcl] \
-relateddir "dirtestdir2.1 dirtestdir2.2" \
-asidefromdir dirtestdir2.2 \
@@ -1147,25 +1147,25 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
# set this to { } instead of just {} to get around quirk in
# Windows env handling that removes empty elements from env array.
set ::env(TCLTEST_OPTIONS) { }
- interp create slave1
- slave1 eval [list set argv {-debug 2}]
- slave1 alias puts puts
- interp create slave2
- slave2 alias puts puts
+ interp create child1
+ child1 eval [list set argv {-debug 2}]
+ child1 alias puts puts
+ interp create child2
+ child2 alias puts puts
} -cleanup {
- interp delete slave2
- interp delete slave1
+ interp delete child2
+ interp delete child1
if {$oldoptions eq "none"} {
unset ::env(TCLTEST_OPTIONS)
} else {
set ::env(TCLTEST_OPTIONS) $oldoptions
}
} -body {
- slave1 eval [package ifneeded tcltest [package provide tcltest]]
- slave1 eval tcltest::debug
+ child1 eval [package ifneeded tcltest [package provide tcltest]]
+ child1 eval tcltest::debug
set ::env(TCLTEST_OPTIONS) "-debug 3"
- slave2 eval [package ifneeded tcltest [package provide tcltest]]
- slave2 eval tcltest::debug
+ child2 eval [package ifneeded tcltest [package provide tcltest]]
+ child2 eval tcltest::debug
} -result {^3$} -match regexp -output\
{tcltest::debug\s+= 2.*tcltest::debug\s+= 3}
@@ -1174,7 +1174,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
cd [temporaryDirectory]
# PrintError
test tcltest-20.1 {PrintError} {unixOrWin} {
- set result [slave msg $printerror]
+ set result [child msg $printerror]
list $result [regexp "Error: a really short string" $msg] \
[regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \
[regexp " \"Really" $msg] [regexp Problem $msg]
@@ -1385,7 +1385,7 @@ test tcltest-21.12 {
set atd [makeDirectory alltestdir]
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import -force tcltest::*
testsDirectory [file join [temporaryDirectory] alltestdir]
runAllTests
@@ -1397,7 +1397,7 @@ makeFile {
error "throw an error"
} error.test $atd
makeFile {
- package require tcltest
+ package require tcltest 2.5
namespace import -force tcltest::*
test foo-1.1 {foo} {
-body { return 1 }
@@ -1407,7 +1407,7 @@ makeFile {
} test.test $atd
# Must use a child process because stdout/stderr parsing can't be
-# duplicated in slave interp.
+# duplicated in child interp.
test tcltest-22.1 {runAllTests} {
-constraints {unixOrWin}
-body {
@@ -1796,7 +1796,7 @@ test tcltest-25.3 {
test tcltest-26.1 {Bug/RFE 1017151} -setup {
makeFile {
- package require tcltest
+ package require tcltest 2.5
set ::errorInfo "Should never see this"
tcltest::test tcltest-26.1.0 {
no errorInfo when only return code mismatch
@@ -1806,7 +1806,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
tcltest::cleanupTests
} test.tcl
} -body {
- slave msg [file join [temporaryDirectory] test.tcl]
+ child msg [file join [temporaryDirectory] test.tcl]
return $msg
} -cleanup {
removeFile test.tcl
@@ -1816,7 +1816,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
test tcltest-26.2 {Bug/RFE 1017151} -setup {
makeFile {
- package require tcltest
+ package require tcltest 2.5
set ::errorInfo "Should never see this"
tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body {
error "body error"
@@ -1826,7 +1826,7 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
tcltest::cleanupTests
} test.tcl
} -body {
- slave msg [file join [temporaryDirectory] test.tcl]
+ child msg [file join [temporaryDirectory] test.tcl]
return $msg
} -cleanup {
removeFile test.tcl
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
index b0aa054..193ba0a 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -1,6 +1,6 @@
#! /usr/bin/env tclsh
-package require tcltest 2.2
+package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint fcopy [llength [info commands fcopy]]
diff --git a/tests/thread.test b/tests/thread.test
index 2524911..0a35d1b 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -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.
@@ -805,7 +805,7 @@ test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -
} -cleanup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
-test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -setup {
+test thread-7.22 {cancel: child interp} -constraints {thread drainEventQueue} -setup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
set serverthread [thread::create -joinable \
@@ -835,7 +835,7 @@ test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -s
} -cleanup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
-test thread-7.23 {cancel: slave interp -unwind} -constraints {thread drainEventQueue} -setup {
+test thread-7.23 {cancel: child interp -unwind} -constraints {thread drainEventQueue} -setup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
set serverthread [thread::create -joinable \
diff --git a/tests/timer.test b/tests/timer.test
index 740d05e..48d88b6 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -568,15 +568,15 @@ test timer-9.1 {AfterCleanupProc procedure} -setup {
} -result {before after2 after4}
test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
- interp create slave
- slave eval namespace export after
- slave eval namespace eval foo namespace import ::after
+ interp create child
+ child eval namespace export after
+ child eval namespace eval foo namespace import ::after
} -body {
- slave eval foo::after 1
- slave eval namespace origin foo::after
+ child eval foo::after 1
+ child eval namespace origin foo::after
} -cleanup {
# Bug will cause crash here; would cause failure otherwise
- interp delete slave
+ interp delete child
} -result ::after
test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} -body {
diff --git a/tests/tm.test b/tests/tm.test
index 001b73e..65629ad 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -6,9 +6,8 @@
# Copyright (c) 2004 by Donal K. Fellows.
# All rights reserved.
-package require Tcl 8.5-
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/trace.test b/tests/trace.test
index 1099f48..3703216 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,8 +11,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -2197,11 +2199,11 @@ foo {if {[catch {bar}]} {
}} 2 error leavestep
foo foo 0 error leave}}
-test trace-28.4 {exec traces in slave with 'return -code error'} {
- interp create slave
- interp alias slave traceExecute {} traceExecute
+test trace-28.4 {exec traces in child with 'return -code error'} {
+ interp create child
+ interp alias child traceExecute {} traceExecute
set info {}
- set res [interp eval slave {
+ set res [interp eval child {
set info {}
set res {}
@@ -2229,7 +2231,7 @@ test trace-28.4 {exec traces in slave with 'return -code error'} {
list $res
}]
- interp delete slave
+ interp delete child
lappend res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 08eb664..1ecaeef 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/unixFile.test b/tests/unixFile.test
index 8147f48..492e5d0 100644
--- a/tests/unixFile.test
+++ b/tests/unixFile.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
index d7b86fd..5233496 100644
--- a/tests/unixForkEvent.test
+++ b/tests/unixForkEvent.test
@@ -8,8 +8,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
testConstraint testfork [llength [info commands testfork]]
diff --git a/tests/unixInit.test b/tests/unixInit.test
index ab00b4e..26d4130 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -10,8 +10,10 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2.2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
unset -nocomplain path
catch {set oldlang $env(LANG)}
set env(LANG) C
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index 0bd8c69..cdf0519 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/unknown.test b/tests/unknown.test
index 6c31c3d..4cad132 100644
--- a/tests/unknown.test
+++ b/tests/unknown.test
@@ -11,8 +11,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest 2
-namespace import ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
unset -nocomplain x
catch {rename unknown unknown.old}
diff --git a/tests/unload.test b/tests/unload.test
index 73f1091..815ff31 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -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/uplevel.test b/tests/uplevel.test
index 2cbea1a..7ba129a 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/upvar.test b/tests/upvar.test
index a483569..9e44a79 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -11,8 +11,8 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/utf.test b/tests/utf.test
index 35d7855..935830c 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -8,23 +8,23 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
-namespace path ::tcl::mathop
-
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
-testConstraint tip389 [expr {[string length [format %c 0x10000]] eq 2}]
+testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}]
testConstraint ucs4 [expr {[testConstraint fullutf]
&& [string length [format %c 0x10000]] == 1}]
+testConstraint ucs2_utf16 [expr {![testConstraint ucs4]}]
-testConstraint Uesc [eq \U0041 A]
+testConstraint Uesc [expr {"\U0041" eq "A"}]
+testConstraint pre388 [expr {"\x741" eq "A"}]
testConstraint pairsTo4bytes [expr {[llength [info commands teststringbytes]]
&& [string length [teststringbytes \uD83D\uDCA9]] == 4}]
@@ -36,101 +36,95 @@ testConstraint teststringobj [llength [info commands teststringobj]]
testConstraint testutfnext [llength [info commands testutfnext]]
testConstraint testutfprev [llength [info commands testutfprev]]
-testConstraint tip413 [eq {} [string trim \x00]]
+testConstraint tip413 [expr {[string trim \x00] eq {}}]
catch {unset x}
test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
- expr {"\x01" eq [testbytestring "\x01"]}
+ expr {"\x01" eq [testbytestring \x01]}
} 1
test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
- expr {"\x00" eq [testbytestring "\xC0\x80"]}
+ expr {"\x00" eq [testbytestring \xC0\x80]}
} 1
test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
- expr {"\xE0" eq [testbytestring "\xC3\xA0"]}
+ expr {"\xE0" eq [testbytestring \xC3\xA0]}
} 1
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {
- expr {"\u4E4E" eq [testbytestring "\xE4\xB9\x8E"]}
+ expr {"\u4E4E" eq [testbytestring \xE4\xB9\x8E]}
} 1
test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
- expr {[format %c 0x110000] eq [testbytestring "\xEF\xBF\xBD"]}
+ expr {[format %c 0x110000] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
- expr {[format %c -1] eq [testbytestring "\xEF\xBF\xBD"]}
+ expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf Uesc testbytestring} {
- expr {"\U014E4E" eq [testbytestring "\xF0\x94\xB9\x8E"]}
+ expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 1
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {ucs2 Uesc testbytestring} {
- expr {"\U014E4E" eq [testbytestring "\xF0\x94\xB9\x8E"]}
+ expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 0
test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
- expr {"\uD842" eq [testbytestring "\xED\xA1\x82"]}
+ expr {"\uD842" eq [testbytestring \xED\xA1\x82]}
} 1
test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
- expr {"\uDC42" eq [testbytestring "\xED\xB1\x82"]}
+ expr {"\uDC42" eq [testbytestring \xED\xB1\x82]}
} 1
test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
- expr {[format %c 0xD842] eq [testbytestring "\xED\xA1\x82"]}
+ expr {[format %c 0xD842] eq [testbytestring \xED\xA1\x82]}
} 1
test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
- expr {[format %c 0xDC42] eq [testbytestring "\xED\xB1\x82"]}
+ expr {[format %c 0xDC42] eq [testbytestring \xED\xB1\x82]}
} 1
test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} {
- expr {"\uD842\uDC42" eq [testbytestring "\xF0\xA0\xA1\x82"]}
+ expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]}
} 1
test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring} {
- expr {"\UD842" eq [testbytestring "\xEF\xBF\xBD"]}
+ expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
} 3
test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring {
- string length [testbytestring "\x82\x83\x84"]
+ string length [testbytestring \x82\x83\x84]
} 3
test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} testbytestring {
- string length [testbytestring "\xC2"]
+ string length [testbytestring \xC2]
} 1
-test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} testbytestring {
- string length [testbytestring "\xC2\xA2"]
+test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} {
+ string length \xA2
} 1
test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} testbytestring {
- string length [testbytestring "\xE2"]
+ string length [testbytestring \xE2]
} 1
test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring {
- string length [testbytestring "\xE2\xA2"]
+ string length [testbytestring \xE2\xA2]
} 2
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
- string length [testbytestring "\xE4\xB9\x8E"]
+ string length [testbytestring \xE4\xB9\x8E]
} 1
-test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} {
- string length [testbytestring "\xF0\x90\x80\x80"]
-} 4
+test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2_utf16} {
+ string length [testbytestring \xF0\x90\x80\x80]
+} 2
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} {
- string length [testbytestring "\xF0\x90\x80\x80"]
+ string length [testbytestring \xF0\x90\x80\x80]
} 1
-test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring tip389} {
- string length [testbytestring "\xF0\x90\x80\x80"]
-} 2
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} {
- string length [testbytestring "\xF4\x8F\xBF\xBF"]
-} 4
-test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} {
- string length [testbytestring "\xF4\x8F\xBF\xBF"]
-} 1
-test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring tip389} {
- string length [testbytestring "\xF4\x8F\xBF\xBF"]
+ string length [testbytestring \xF4\x8F\xBF\xBF]
} 2
+test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} {
+ string length \U10FFFF
+} 1
test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
- string length [testbytestring "\xF0\x8F\xBF\xBF"]
+ string length [testbytestring \xF0\x8F\xBF\xBF]
} 4
test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring {
# Would decode to U+110000 but that is outside the Unicode range.
- string length [testbytestring "\xF4\x90\x80\x80"]
+ string length [testbytestring \xF4\x90\x80\x80]
} 4
test utf-2.12 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring {
- string length [testbytestring "\xF8\xA2\xA2\xA2\xA2"]
+ string length [testbytestring \xF8\xA2\xA2\xA2\xA2]
} 5
test utf-3.1 {Tcl_UtfCharComplete} {
@@ -139,334 +133,376 @@ test utf-3.1 {Tcl_UtfCharComplete} {
test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
testnumutfchars ""
} 0
-test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "\xC2\xA2"]
+test utf-4.2 {Tcl_NumUtfChars: length 1} testnumutfchars {
+ testnumutfchars \xA2
} 1
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\xA2\x4E"]
+ testnumutfchars abc\xA2[testbytestring \xE4\xB9\x8E\xA2\x4E]
} 7
-test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "\xC0\x80"]
+test utf-4.4 {Tcl_NumUtfChars: #x00} testnumutfchars {
+ testnumutfchars \x00
} 1
test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars {
testnumutfchars "" 0
} 0
test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "\xC2\xA2"] end
+ testnumutfchars \xA2 end
} 1
test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] end
+ testnumutfchars abc\xA2[testbytestring \xE4\xB9\x8E\xA2\x4E] end
} 7
-test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "\xC0\x80"] end
+test utf-4.8 {Tcl_NumUtfChars: #x00, calc len} testnumutfchars {
+ testnumutfchars \x00 end
} 1
# Bug [2738427]: Tcl_NumUtfChars(...) no overflow check
test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "\xE2\x82\xAC"] end-1
+ testnumutfchars [testbytestring \xE2\x82\xAC] end-1
} 2
-test utf-4.10 {Tcl_NumUtfChars: #u0000, calc len, overcomplete} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "\x00"] end+1
+test utf-4.10 {Tcl_NumUtfChars: #x00, calc len, overcomplete} {testnumutfchars testbytestring} {
+ testnumutfchars [testbytestring \x00] end+1
} 2
test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} {
testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1
} 3
test utf-4.12.0 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs2} {
testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end
-} 4
+} 2
test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs4} {
testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end
} 1
-test utf-4.12.2 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring tip389} {
- testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end
-} 2
+test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} {
+ testnumutfchars foobar[testbytestring \xF2\xC2\xA0] end
+} 8
+test utf-4.14 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} {
+ testnumutfchars [testbytestring \xF4\x90\x80\x80] end-1
+} 3
test utf-5.1 {Tcl_UtfFindFirst} {testfindfirst testbytestring} {
- testfindfirst [testbytestring "abcbc"] 98
+ testfindfirst [testbytestring abcbc] 98
} bcbc
test utf-5.2 {Tcl_UtfFindLast} {testfindlast testbytestring} {
- testfindlast [testbytestring "abcbc"] 98
+ testfindlast [testbytestring abcbc] 98
} bc
-test utf-6.1 {Tcl_UtfNext} testutfnext {
+test utf-6.1 {Tcl_UtfNext} {testutfnext testbytestring} {
# This takes the pointer one past the terminating NUL.
# This is really an invalid call.
- testutfnext -bytestring {}
+ testutfnext [testbytestring \x00]
} 1
test utf-6.2 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring A
+ testutfnext A
} 1
test utf-6.3 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring AA
+ testutfnext AA
} 1
-test utf-6.4 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring A\xA0
+test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext A[testbytestring \xA0]
} 1
-test utf-6.5 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring A\xD0
+test utf-6.5 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext A[testbytestring \xD0]
} 1
-test utf-6.6 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring A\xE8
+test utf-6.6 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext A[testbytestring \xE8]
} 1
-test utf-6.7 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring A\xF2
+test utf-6.7 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext A[testbytestring \xF2]
} 1
-test utf-6.8 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring A\xF8
+test utf-6.8 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext A[testbytestring \xF8]
} 1
-test utf-6.9 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0
+test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\x00]
} 1
-test utf-6.10 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0G
+test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0]G
} 1
-test utf-6.11 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0\xA0
+test utf-6.11 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xA0\x00]
} 2
-test utf-6.12 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0\xD0
+test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xD0]
} 1
-test utf-6.13 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0\xE8
+test utf-6.13 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xE8]
} 1
-test utf-6.14 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0\xF2
+test utf-6.14 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xF2]
} 1
-test utf-6.15 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xA0\xF8
+test utf-6.15 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xF8]
} 1
-test utf-6.16 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0
+test utf-6.16 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\x00]
} 1
-test utf-6.17 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0G
+test utf-6.17 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0]G
} 1
-test utf-6.18 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0
+test utf-6.18 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0]
} 2
-test utf-6.19 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xD0
+test utf-6.19 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xD0]
} 1
-test utf-6.20 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xE8
+test utf-6.20 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xE8]
} 1
-test utf-6.21 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xF2
+test utf-6.21 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xF2]
} 1
-test utf-6.22 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xF8
+test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xF8]
} 1
-test utf-6.23 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8
-} 1
-test utf-6.24 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8G
+test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8]
+} -1
+test utf-6.24 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8]G
} 1
-test utf-6.25 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0
+test utf-6.25 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xA0\x00]
} 1
-test utf-6.26 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xD0
+test utf-6.26 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xD0]
} 1
-test utf-6.27 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xE8
+test utf-6.27 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xE8]
} 1
-test utf-6.28 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xF2
+test utf-6.28 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xF2]
} 1
-test utf-6.29 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xF8
+test utf-6.29 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xF8]
} 1
-test utf-6.30 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2
+test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2]
} 1
-test utf-6.31 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2G
+test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2]
+} -1
+test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2]G
} 1
-test utf-6.32 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0
+test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0]
} 1
-test utf-6.33 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xD0
+test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0]
+} -1
+test utf-6.33 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xD0]
} 1
-test utf-6.34 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xE8
+test utf-6.34 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xE8]
} 1
-test utf-6.35 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xF2
+test utf-6.35 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xF2]
} 1
-test utf-6.36 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xF8
+test utf-6.36 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xF8]
} 1
-test utf-6.37 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8
+test utf-6.37 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8]
} 1
-test utf-6.38 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8G
+test utf-6.38 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8]G
} 1
-test utf-6.39 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8\xA0
+test utf-6.39 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8\xA0]
} 1
-test utf-6.40 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8\xD0
+test utf-6.40 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8\xD0]
} 1
-test utf-6.41 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8\xE8
+test utf-6.41 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8\xE8]
} 1
-test utf-6.42 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8\xF2
+test utf-6.42 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8\xF2]
} 1
-test utf-6.43 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF8\xF8
+test utf-6.43 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF8\xF8]
} 1
-test utf-6.44 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0G
+test utf-6.44 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0]G
} 2
-test utf-6.45 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0\xA0
+test utf-6.45 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0\xA0]
} 2
-test utf-6.46 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0\xD0
+test utf-6.46 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0\xD0]
} 2
-test utf-6.47 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0\xE8
+test utf-6.47 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0\xE8]
} 2
-test utf-6.48 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0\xF2
+test utf-6.48 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0\xF2]
} 2
-test utf-6.49 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xD0\xA0\xF8
+test utf-6.49 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xD0\xA0\xF8]
} 2
-test utf-6.50 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0G
+test utf-6.50 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xA0]G
} 1
test utf-6.51 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0
+ testutfnext \u8820
} 3
-test utf-6.52 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xD0
+test utf-6.52 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xA0\xD0]
} 1
-test utf-6.53 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xE8
+test utf-6.53 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xA0\xE8]
} 1
-test utf-6.54 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xF2
+test utf-6.54 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xA0\xF2]
} 1
-test utf-6.55 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xF8
+test utf-6.55 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE8\xA0\xF8]
} 1
-test utf-6.56 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0G
+test utf-6.56 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0]G
} 1
-test utf-6.57 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0
+test utf-6.57 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xA0\x00]
} 1
-test utf-6.58 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xD0
+test utf-6.58 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xD0]
} 1
-test utf-6.59 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xE8
+test utf-6.59 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xE8]
} 1
-test utf-6.60 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xF2
+test utf-6.60 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xF2]
} 1
-test utf-6.61 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xF8
+test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xF8]
} 1
test utf-6.62 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0G
+ testutfnext \u8820G
} 3
-test utf-6.63 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0\xA0
+test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext \u8820[testbytestring \xA0]
} 3
-test utf-6.64 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0\xD0
+test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext \u8820[testbytestring \xD0]
} 3
-test utf-6.65 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0\xE8
+test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext \u8820[testbytestring \xE8]
} 3
-test utf-6.66 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0\xF2
+test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext \u8820[testbytestring \xF2]
} 3
-test utf-6.67 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xE8\xA0\xA0\xF8
+test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext \u8820[testbytestring \xF8]
} 3
-test utf-6.68 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0G
+test utf-6.68 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xA0]G
+} 1
+test utf-6.69.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0]
} 1
-test utf-6.69 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0
+test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0]
} 4
-test utf-6.70 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xD0
+test utf-6.70 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xD0]
+} 1
+test utf-6.71 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xE8]
} 1
-test utf-6.71 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xE8
+test utf-6.72 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xF2]
} 1
-test utf-6.72 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xF2
+test utf-6.73 {Tcl_UtfNext} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xF8]
} 1
-test utf-6.73 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xF8
+test utf-6.74.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0]G
} 1
-test utf-6.74 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0G
+test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0]G
} 4
-test utf-6.75 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0\xA0
+test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0]
+} 1
+test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0]
} 4
-test utf-6.76 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0\xD0
+test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0]
+} 1
+test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0]
} 4
-test utf-6.77 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0\xE8
+test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8]
+} 1
+test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8]
} 4
-test utf-6.78 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0\xF2
+test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2]
+} 1
+test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2]
} 4
-test utf-6.79 {Tcl_UtfNext} testutfnext {
- testutfnext -bytestring \xF2\xA0\xA0\xA0G\xF8
+test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8]
+} 1
+test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8]
} 4
test utf-6.80 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xC0\x80
+ testutfnext \x00
} 2
-test utf-6.81 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xC0\x81
+test utf-6.81 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xC0\x81]
} 1
-test utf-6.82 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xC1\x80
+test utf-6.82 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xC1\x80]
} 1
-test utf-6.83 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xC2\x80
+test utf-6.83 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xC2\x80]
} 2
-test utf-6.84 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xE0\x80\x80
+test utf-6.84 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE0\x80\x80]
} 1
-test utf-6.85 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xE0\xA0\x80
+test utf-6.85 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xE0\xA0\x80]
} 3
-test utf-6.86 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xF0\x80\x80\x80
+test utf-6.86 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF0\x80\x80\x80]
+} 1
+test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF0\x90\x80\x80]
} 1
-test utf-6.87 {Tcl_UtfNext - overlong sequences} testutfnext {
- testutfnext -bytestring \xF0\x90\x80\x80
+test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF0\x90\x80\x80]
} 4
-test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} testutfnext {
- testutfnext -bytestring \xA0\xA0
+test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xA0\x00]
} 2
-test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} testutfnext {
- testutfnext -bytestring \x80\x80
+test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} {
+ testutfnext [testbytestring \x80\x80\x00]
} 2
-test utf-6.90 {Tcl_UtfNext, validity check [493dccc2de]} testutfnext {
- testutfnext -bytestring \xF4\x8F\xBF\xBF
+test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2_utf16} {
+ testutfnext [testbytestring \xF4\x8F\xBF\xBF]
+} 1
+test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs4} {
+ testutfnext [testbytestring \xF4\x8F\xBF\xBF]
} 4
-test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} testutfnext {
- testutfnext -bytestring \xF4\x90\x80\x80
+test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xF4\x90\x80\x80]
} 1
-test utf-6.92 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} testutfnext {
- testutfnext -bytestring \xA0\xA0\xA0
+test utf-6.92 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xA0\xA0]
+} 3
+test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} {
+ testutfnext [testbytestring \x80\x80\x80]
+} 3
+test utf-6.94 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
+ testutfnext [testbytestring \xA0\xA0\xA0\xA0]
} 3
-test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} testutfnext {
- testutfnext -bytestring \x80\x80\x80
+test utf-6.95 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
+ testutfnext [testbytestring \x80\x80\x80\x80]
} 3
test utf-7.1 {Tcl_UtfPrev} testutfprev {
@@ -478,266 +514,296 @@ test utf-7.2 {Tcl_UtfPrev} testutfprev {
test utf-7.3 {Tcl_UtfPrev} testutfprev {
testutfprev AA
} 1
-test utf-7.4 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8
+test utf-7.4 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8]
} 1
-test utf-7.4.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xA0\xA0 2
+test utf-7.4.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 2
} 1
-test utf-7.4.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xF8\xA0\xA0 2
+test utf-7.4.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xF8\xA0\xA0] 2
} 1
-test utf-7.5 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2
+test utf-7.5 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF2]
} 1
-test utf-7.5.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xA0\xA0 2
+test utf-7.5.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 2
} 1
-test utf-7.5.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xF8\xA0\xA0 2
+test utf-7.5.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF2\xF8\xA0\xA0] 2
} 1
-test utf-7.6 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8
+test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE8]
} 1
-test utf-7.6.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xA0\xA0 2
+test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A\u8820[testbytestring \xA0] 2
} 1
-test utf-7.6.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xF8\xA0\xA0 2
+test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2
} 1
-test utf-7.7 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0
+test utf-7.7 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0]
} 1
-test utf-7.7.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xA0\xA0 2
+test utf-7.7.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 2
} 1
-test utf-7.7.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xF8\xA0\xA0 2
+test utf-7.7.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xF8\xA0\xA0] 2
} 1
-test utf-7.8 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0
+test utf-7.8 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xA0]
} 1
-test utf-7.8.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xA0\xA0 2
+test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 2
} 1
-test utf-7.8.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xF8\xA0\xA0 2
+test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xA0\xF8\xA0\xA0] 2
} 1
-test utf-7.9 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0
+test utf-7.9 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0]
} 2
-test utf-7.9.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xA0\xA0 3
+test utf-7.9.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 3
} 2
-test utf-7.9.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xF8\xA0 3
+test utf-7.9.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0\xF8\xA0] 3
} 2
-test utf-7.10 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0
+test utf-7.10.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF2\xA0]
+} 2
+test utf-7.10.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF2\xA0]
} 1
-test utf-7.10.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xA0\xA0 3
+test utf-7.10.2 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 3
+} 2
+test utf-7.10.3 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 3
} 1
-test utf-7.10.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xF8\xA0 3
+test utf-7.10.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3
+} 2
+test utf-7.10.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3
} 1
-test utf-7.11 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0
+test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE8\xA0]
} 1
-test utf-7.11.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xA0\xA0 3
+test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A\u8820[testbytestring \xA0] 3
} 1
-test utf-7.11.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xF8\xA0 3
+test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3
} 1
-test utf-7.11.3 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xF8 3
+test utf-7.11.3 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE8\xA0\xF8] 3
} 1
-test utf-7.12 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0
+test utf-7.12 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0]
} 1
-test utf-7.12.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xA0\xA0 3
+test utf-7.12.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 3
} 1
-test utf-7.12.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xF8\xA0 3
+test utf-7.12.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0\xF8\xA0] 3
} 1
-test utf-7.13 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0
+test utf-7.13 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xA0\xA0]
} 2
-test utf-7.13.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xA0\xA0 3
+test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 3
} 2
-test utf-7.13.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xF8\xA0 3
+test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xA0\xA0\xF8\xA0] 3
} 2
-test utf-7.14 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xA0
+test utf-7.14 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0\xA0]
} 3
-test utf-7.14.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xA0\xA0 4
+test utf-7.14.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 4
} 3
-test utf-7.14.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xA0\xF8 4
+test utf-7.14.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF8\xA0\xA0\xF8] 4
} 3
-test utf-7.15 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xA0
+test utf-7.15.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF2\xA0\xA0]
+} 3
+test utf-7.15.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF2\xA0\xA0]
} 1
-test utf-7.15.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xA0\xA0 4
+test utf-7.15.2 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 4
+} 3
+test utf-7.15.3 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 4
} 1
-test utf-7.15.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xA0\xF8 4
+test utf-7.15.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
+} 3
+test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
} 1
test utf-7.16 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xA0
+ testutfprev A\u8820
} 1
-test utf-7.16.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xA0\xA0 4
+test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A\u8820[testbytestring \xA0] 4
} 1
-test utf-7.16.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xA0\xF8 4
+test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A\u8820[testbytestring \xF8] 4
} 1
-test utf-7.17 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xA0
-} 3
-test utf-7.17.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xA0\xA0 4
-} 3
-test utf-7.17.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xA0\xF8 4
-} 3
-test utf-7.18 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xA0
+test utf-7.17 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0\xA0]
} 3
-test utf-7.18.1 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xA0\xA0 4
+test utf-7.17.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 4
} 3
-test utf-7.18.2 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xA0\xF8 4
+test utf-7.17.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xD0\xA0\xA0\xF8] 4
} 3
-test utf-7.19 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF8\xA0\xA0\xA0
-} 4
-test utf-7.20 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xF2\xA0\xA0\xA0
+test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xA0\xA0\xA0]
} 1
-test utf-7.21 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xE8\xA0\xA0\xA0
-} 4
-test utf-7.22 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xD0\xA0\xA0\xA0
-} 4
-test utf-7.23 {Tcl_UtfPrev} testutfprev {
- testutfprev A\xA0\xA0\xA0\xA0
-} 4
-test utf-7.24 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xC0\x81
+test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 4
+} 1
+test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xA0\xA0\xA0\xF8] 4
+} 1
+test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xF8\xA0\xA0\xA0]
+} 2
+test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xF2\xA0\xA0\xA0]
+} 2
+test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A\u8820[testbytestring \xA0]
+} 2
+test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xD0\xA0\xA0\xA0]
+} 2
+test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xA0\xA0\xA0\xA0]
+} 2
+test utf-7.24 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xC0\x81]
} 2
-test utf-7.25 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xC0\x81 2
+test utf-7.25 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xC0\x81] 2
} 1
-test utf-7.26 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\x80\x80
+test utf-7.26 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\x80\x80]
} 3
-test utf-7.27 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\x80
+test utf-7.27 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\x80]
} 2
-test utf-7.27.1 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\x80\x80 3
+test utf-7.27.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\x80\x80] 3
} 2
-test utf-7.28 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0
+test utf-7.28 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0]
} 1
-test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\x80\x80 2
+test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\x80\x80] 2
} 1
-test utf-7.29 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x80\x80\x80
-} 4
-test utf-7.30 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x80\x80\x80 4
+test utf-7.29 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xF0\x80\x80\x80]
+} 2
+test utf-7.30 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF0\x80\x80\x80] 4
} 3
-test utf-7.31 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x80\x80\x80 3
+test utf-7.31 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF0\x80\x80\x80] 3
} 2
-test utf-7.32 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x80\x80\x80 2
+test utf-7.32 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF0\x80\x80\x80] 2
} 1
test utf-7.33 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xC0\x80
+ testutfprev A\x00
} 1
-test utf-7.34 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xC1\x80
+test utf-7.34 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xC1\x80]
} 2
-test utf-7.35 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xC2\x80
-} 1
-test utf-7.36 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\xA0\x80
+test utf-7.35 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xC2\x80]
} 1
-test utf-7.37 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\xA0\x80 3
+test utf-7.36 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\xA0\x80]
} 1
-test utf-7.38 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xE0\xA0\x80 2
+test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\xA0\x80] 3
} 1
-test utf-7.39 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x90\x80\x80
+test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xE0\xA0\x80] 2
} 1
-test utf-7.40 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x90\x80\x80 4
+test utf-7.39 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xF0\x90\x80\x80]
+} 2
+test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF0\x90\x80\x80] 4
+} 3
+test utf-7.40.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF0\x90\x80\x80] 4
} 1
-test utf-7.41 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x90\x80\x80 3
+test utf-7.41.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF0\x90\x80\x80] 3
+} 2
+test utf-7.41.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF0\x90\x80\x80] 3
} 1
-test utf-7.42 {Tcl_UtfPrev -- overlong sequence} testutfprev {
- testutfprev A\xF0\x90\x80\x80 2
+test utf-7.42 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF0\x90\x80\x80] 2
} 1
-test utf-7.43 {Tcl_UtfPrev -- no lead byte at start} testutfprev {
- testutfprev \xA0
+test utf-7.43 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} {
+ testutfprev [testbytestring \xA0]
} 0
-test utf-7.44 {Tcl_UtfPrev -- no lead byte at start} testutfprev {
- testutfprev \xA0\xA0
+test utf-7.44 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} {
+ testutfprev [testbytestring \xA0\xA0]
} 1
-test utf-7.45 {Tcl_UtfPrev -- no lead byte at start} testutfprev {
- testutfprev \xA0\xA0\xA0
+test utf-7.45 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} {
+ testutfprev [testbytestring \xA0\xA0\xA0]
} 2
-test utf-7.46 {Tcl_UtfPrev -- no lead byte at start} testutfprev {
- testutfprev \xA0\xA0\xA0\xA0
-} 3
-test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev {
- testutfprev \xE8\xA0
+test utf-7.46 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring utf16} {
+ testutfprev [testbytestring \xA0\xA0\xA0\xA0]
+} 1
+test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {testutfprev testbytestring} {
+ testutfprev [testbytestring \xE8\xA0]
} 0
test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev {
- testutfprev \xE8\xA0\xA0 2
+ testutfprev \u8820 2
} 0
-test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} testutfprev {
- testutfprev \xE8\xA0\x00 2
+test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} {
+ testutfprev [testbytestring \xE8\xA0\x00] 2
} 0
-test utf-7.48 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x8F\xBF\xBF
-} 1
-test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x8F\xBF\xBF 4
+test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
+} 2
+test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
+} 3
+test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 1
-test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x8F\xBF\xBF 3
+test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
+ testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
+} 2
+test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
+ testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 1
-test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x8F\xBF\xBF 2
+test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2
} 1
-test utf-7.49 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x90\x80\x80
-} 4
-test utf-7.49.1 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x90\x80\x80 4
+test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} {
+ testutfprev A[testbytestring \xF4\x90\x80\x80]
+} 2
+test utf-7.49.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF4\x90\x80\x80] 4
} 3
-test utf-7.49.2 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x90\x80\x80 3
+test utf-7.49.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF4\x90\x80\x80] 3
} 2
-test utf-7.49.3 {Tcl_UtfPrev, validity check [493dccc2de]} testutfprev {
- testutfprev A\xF4\x90\x80\x80 2
+test utf-7.49.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
+ testutfprev A[testbytestring \xF4\x90\x80\x80] 2
} 1
test utf-8.1 {Tcl_UniCharAtIndex: index = 0} {
@@ -745,49 +811,150 @@ test utf-8.1 {Tcl_UniCharAtIndex: index = 0} {
} a
test utf-8.2 {Tcl_UniCharAtIndex: index = 0} {
string index \u4E4E\u25A 0
-} "\u4E4E"
+} \u4E4E
test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
string index abcd 2
} c
test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
string index \u4E4E\u25A\xFF\u543 2
-} "\uFF"
-test utf-8.5 {Tcl_UniCharAtIndex: high surrogate} {
+} \xFF
+test utf-8.5.0 {Tcl_UniCharAtIndex: high surrogate} ucs2 {
+ string index \uD842 0
+} \uD842
+test utf-8.5.1 {Tcl_UniCharAtIndex: high surrogate} ucs4 {
string index \uD842 0
-} "\uD842"
+} \uD842
+test utf-8.5.2 {Tcl_UniCharAtIndex: high surrogate} utf16 {
+ string index \uD842 0
+} \uD842
test utf-8.6 {Tcl_UniCharAtIndex: low surrogate} {
string index \uDC42 0
-} "\uDC42"
-test utf-8.7 {Tcl_UniCharAtIndex: Emoji} {
- string index \U1F600 0
-} "\U1F600"
-test utf-8.8 {Tcl_UniCharAtIndex: Emoji} {
- string index \U1F600 1
+} \uDC42
+test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
+ string index \uD83D\uDE00G 0
+} \uD83D
+test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
+ string index \uD83D\uDE00G 0
+} \U1F600
+test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
+ string index \uD83D\uDE00G 0
+} \U1F600
+test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
+ string index \uD83D\uDE00G 1
+} \uDE00
+test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
+ string index \uD83D\uDE00G 1
+} G
+test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
+ string index \uD83D\uDE00G 1
+} {}
+test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
+ string index \uD83D\uDE00G 2
+} G
+test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
+ string index \uD83D\uDE00G 2
+} {}
+test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
+ string index \uD83D\uDE00G 2
+} G
+test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
+ string index \U1F600G 0
+} \uFFFD
+test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
+ string index \U1F600G 0
+} \U1F600
+test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
+ string index \U1F600G 0
+} \U1F600
+test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
+ string index \U1F600G 1
+} G
+test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
+ string index \U1F600G 1
+} G
+test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
+ string index \U1F600G 1
} {}
+test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
+ string index \U1F600G 2
+} {}
+test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
+ string index \U1F600G 2
+} {}
+test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
+ string index \U1F600G 2
+} G
test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
string range abcd 0 2
} abc
test utf-9.2 {Tcl_UtfAtIndex: index > 0} {
string range \u4E4E\u25A\xFF\u543klmnop 1 5
-} "\u25A\xFF\u543kl"
-test utf-9.3 {Tcl_UtfAtIndex: index = 0, Emoji} {
- string range \U1F600G 0 0
-} "\U1F600"
-test utf-9.4 {Tcl_UtfAtIndex: index > 0, Emoji} tip389 {
- string range \U1F600G 1 1
+} \u25A\xFF\u543kl
+test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 {
+ string range \uD83D\uDE00G 0 0
+} \uD83D
+test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
+ string range \uD83D\uDE00G 0 0
+} \U1F600
+test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
+ string range \uD83D\uDE00G 0 0
+} \U1F600
+test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
+ string range \uD83D\uDE00G 1 1
+} \uDE00
+test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
+ string range \uD83D\uDE00G 1 1
+} G
+test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
+ string range \uD83D\uDE00G 1 1
} {}
-
+test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
+ string range \uD83D\uDE00G 2 2
+} G
+test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
+ string range \uD83D\uDE00G 2 2
+} {}
+test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
+ string range \uD83D\uDE00G 2 2
+} G
+test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} {
+ string range \U1f600G 0 0
+} \uFFFD
+test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs4} {
+ string range \U1f600G 0 0
+} \U1F600
+test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc utf16} {
+ string range \U1f600G 0 0
+} \U1F600
+test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
+ string range \U1f600G 1 1
+} G
+test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
+ string range \U1f600G 1 1
+} G
+test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
+ string range \U1f600G 1 1
+} {}
+test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
+ string range \U1f600G 2 2
+} {}
+test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
+ string range \U1f600G 2 2
+} {}
+test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
+ string range \U1f600G 2 2
+} G
test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
set x \n
} {
}
test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring {
- expr {"\uA2" eq [testbytestring "\xC2\xA2"]}
+ expr {"\uA2" eq [testbytestring \xC2\xA2]}
} 1
test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring {
- expr {"\u4E21" eq [testbytestring "\xE4\xB8\xA1"]}
+ expr {"\u4E21" eq [testbytestring \xE4\xB8\xA1]}
} 1
test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
expr {"\u4E2k" eq "[testbytestring \xD3\xA2]k"}
@@ -795,15 +962,16 @@ test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {
expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"}
} 1
-test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} testbytestring {
+test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {Uesc fullutf testbytestring} {
expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"}
} 1
-test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} testbytestring {
+test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {Uesc fullutf testbytestring} {
expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"}
} 1
-proc bsCheck {char num} {
+
+proc bsCheck {char num {constraints {}}} {
global errNum
- test utf-10.$errNum {backslash substitution} {
+ test utf-10.$errNum {backslash substitution} $constraints {
scan $char %c value
set value
} $num
@@ -838,7 +1006,8 @@ bsCheck \x 120
bsCheck \xa 10
bsCheck \xA 10
bsCheck \x41 65
-bsCheck \x541 84
+bsCheck \x541 65 pre388 ;# == \x41
+bsCheck \x541 84 !pre388 ;# == \x54 1
bsCheck \u 117
bsCheck \uk 117
bsCheck \u41 65
@@ -847,24 +1016,25 @@ bsCheck \uA 10
bsCheck \340 224
bsCheck \uA1 161
bsCheck \u4E21 20001
-bsCheck \741 60
-bsCheck \U 85
-bsCheck \Uk 85
-bsCheck \U41 65
-bsCheck \Ua 10
-bsCheck \UA 10
-bsCheck \Ua1 161
-bsCheck \U4E21 20001
-bsCheck \U004E21 20001
-bsCheck \U00004E21 20001
-bsCheck \U0000004E21 78
-bsCheck \U00110000 69632
-bsCheck \U01100000 69632
-bsCheck \U11000000 69632
-bsCheck \U0010FFFF 1114111
-bsCheck \U010FFFF0 1114111
-bsCheck \U10FFFF00 1114111
-bsCheck \UFFFFFFFF 1048575
+bsCheck \741 225 pre388 ;# == \341
+bsCheck \741 60 !pre388 ;# == \74 1
+bsCheck \U 85
+bsCheck \Uk 85
+bsCheck \U41 65 Uesc
+bsCheck \Ua 10 Uesc
+bsCheck \UA 10 Uesc
+bsCheck \UA1 161 Uesc
+bsCheck \U4E21 20001 Uesc
+bsCheck \U004E21 20001 Uesc
+bsCheck \U00004E21 20001 Uesc
+bsCheck \U0000004E21 78 Uesc
+bsCheck \U00110000 69632 {Uesc fullutf}
+bsCheck \U01100000 69632 {Uesc fullutf}
+bsCheck \U11000000 69632 {Uesc fullutf}
+bsCheck \U0010FFFF 1114111 {Uesc fullutf}
+bsCheck \U010FFFF0 1114111 {Uesc fullutf}
+bsCheck \U10FFFF00 1114111 {Uesc fullutf}
+bsCheck \UFFFFFFFF 1048575 {Uesc fullutf}
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
@@ -884,7 +1054,7 @@ test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} {Uesc fullutf} {
string toupper \U10428
} \U10400
-test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} {pairsTo4bytes} {
+test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
string toupper \uD801\uDC28
} \uD801\uDC00
test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} {
@@ -912,7 +1082,7 @@ test utf-12.6 {Tcl_UtfToLower low/high surrogate)} {
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} {Uesc fullutf} {
string tolower \U10400
} \U10428
-test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} {pairsTo4bytes} {
+test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf {
string tolower \uD801\uDC00
} \uD801\uDC28
@@ -938,11 +1108,11 @@ test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
string totitle \uDC24\uD824
} \uDC24\uD824
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} {Uesc fullutf} {
- string totitle \U10428
-} \U10400
-test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} {pairsTo4bytes} {
- string totitle \uD801\uDC28
-} \uD801\uDC00
+ string totitle \U10428\U10400
+} \U10400\U10428
+test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
+ string totitle \uD801\uDC28\uD801\uDC00
+} \uD801\uDC00\uD801\uDC28
test utf-14.1 {Tcl_UtfNcasecmp} {
string compare -nocase a b
@@ -971,8 +1141,8 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} {
string tolower aA
} aa
test utf-16.2 {Tcl_UniCharToLower, positive delta} {
- string tolower \u0178\xFF\uA78D\u01C5\U10400
-} \xFF\xFF\u0265\u01C6\U10428
+ string tolower \u0178\xFF\uA78D\u01C5
+} \xFF\xFF\u0265\u01C6
test utf-17.1 {Tcl_UniCharToLower, no delta} {
string tolower !
@@ -1000,8 +1170,18 @@ test utf-19.1 {TclUniCharLen} -body {
unset -nocomplain foo
} -result {1 4}
-test utf-20.1 {TclUniCharNcmp} {
-} {}
+test utf-20.1 {TclUniCharNcmp} ucs4 {
+ string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0]
+} -1
+test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} knownBug {
+ set one [format %c 0xFFFF]
+ set two [format %c 0x10000]
+ set first [string compare $one $two]
+ string range $one 0 0
+ string range $two 0 0
+ set second [string compare $one $two]
+ expr {($first == $second) ? "agree" : "disagree"}
+} agree
test utf-21.1 {TclUniCharIsAlnum} {
# this returns 1 with Unicode 7 compliance
@@ -1094,67 +1274,52 @@ test utf-24.6 {unicode space char in regc_locale.c} tip413 {
list [regexp {^[[:space:]]+$} \x85\u1680\u180E\u200B\u202F\u2060] [regexp {^\s+$} \x85\u1680\u180E\u200B\u202F\u2060]
} {1 1}
-test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \
- -setup {
- testobj freeallvars
- } \
- -body {
- teststringobj set 1 a
- teststringobj set 2 b
- teststringobj maxchars 1
- teststringobj maxchars 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
- } \
- -cleanup {
+proc UniCharCaseCmpTest {order one two {constraints {}}} {
+ variable count
+ test utf-25.$count {Tcl_UniCharNcasecmp} -setup {
testobj freeallvars
- } \
- -result -1
-test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \
- -setup {
+ } -constraints [linsert $constraints 0 teststringobj] -cleanup {
testobj freeallvars
- } \
- -body {
- teststringobj set 1 b
- teststringobj set 2 a
+ } -body {
+ teststringobj set 1 $one
+ teststringobj set 2 $two
teststringobj maxchars 1
teststringobj maxchars 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
- } \
- -cleanup {
- testobj freeallvars
- } \
- -result 1
-test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \
- -setup {
- testobj freeallvars
- } \
- -body {
- teststringobj set 1 B
- teststringobj set 2 a
- teststringobj maxchars 1
- teststringobj maxchars 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
- } \
- -cleanup {
- testobj freeallvars
- } \
- -result 1
+ set result [string compare -nocase [teststringobj get 1] [teststringobj get 2]]
+ if {$result eq [string map {< -1 = 0 > 1} $order]} {
+ set result ok
+ } else {
+ set result "'$one' should be $order '$two' (no case)"
+ }
+ set result
+ } -result ok
+ incr count
+}
+variable count 1
+UniCharCaseCmpTest < a b
+UniCharCaseCmpTest > b a
+UniCharCaseCmpTest > B a
+UniCharCaseCmpTest > aBcB abca
+UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4
+UniCharCaseCmpTest < \uFFFF \U10000 {Uesc ucs4}
+UniCharCaseCmpTest > [format %c 0x10000] \uFFFF ucs4
+UniCharCaseCmpTest > \U10000 \uFFFF {Uesc ucs4}
-test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \
- -setup {
- testobj freeallvars
- } \
- -body {
- teststringobj set 1 aBcB
- teststringobj set 2 abca
- teststringobj maxchars 1
- teststringobj maxchars 2
- string compare -nocase [teststringobj get 1] [teststringobj get 2]
- } \
- -cleanup {
- testobj freeallvars
- } \
- -result 1
+
+test utf-26.1 {Tcl_UniCharDString} -setup {
+ testobj freeallvars
+} -constraints {teststringobj testbytestring} -cleanup {
+ testobj freeallvars
+} -body {
+ teststringobj set 1 foo
+ teststringobj maxchars 1
+ teststringobj append 1 [testbytestring barsoom\xF2\xC2\x80] 10
+ scan [string index [teststringobj get 1] 11] %c
+} -result 128
+
+
+unset count
+rename UniCharCaseCmpTest {}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/util.test b/tests/util.test
index 1d8162c..e1bd247 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -7,8 +7,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -818,6 +818,9 @@ test util-9.57 {Tcl_GetIntForIndex} {
test util-9.58 {Tcl_GetIntForIndex} -body {
string index abcd end--0x8000000000000000
} -result {}
+test util-9.59 {Tcl_GetIntForIndex} {
+ string index abcd 0-0x10000000000000000
+} {}
test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
convertDouble 0x0000000000000000
diff --git a/tests/var.test b/tests/var.test
index a5b91f8..72873b7 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -15,7 +15,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -1040,15 +1040,15 @@ test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
} -result 0
test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
proc doit {} {
- interp create slave
- slave eval {
+ interp create child
+ child eval {
proc doit script {
eval $script
set foo bar
}
doit {foreach foo baz {}}
}
- interp delete slave
+ interp delete child
}
} -constraints memory -body {
set end [getbytes]
diff --git a/tests/while-old.test b/tests/while-old.test
index ee17d0b..eddc025 100644
--- a/tests/while-old.test
+++ b/tests/while-old.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/while.test b/tests/while.test
index 642ec93..30aff4b 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/winConsole.test b/tests/winConsole.test
index fdde41c..9075ff3 100644
--- a/tests/winConsole.test
+++ b/tests/winConsole.test
@@ -9,8 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/winDde.test b/tests/winDde.test
index acba304..5e90208 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -10,8 +10,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
- #tcltest::configure -verbose {pass start}
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -43,7 +42,7 @@ proc createChildProcess {ddeServerName args} {
# DDE child server -
#
if {"::tcltest" ni [namespace children]} {
- package require tcltest
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -279,19 +278,19 @@ test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio}
# -------------------------------------------------------------------------
-test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup {
- interp create slave
+test winDde-7.1 {Load DDE in child interpreter} -constraints dde -setup {
+ interp create child
} -body {
- slave eval [list load $::ddelib Dde]
- slave eval [list dde servername -- dde-interp-7.1]
+ child eval [list load $::ddelib Dde]
+ child eval [list dde servername -- dde-interp-7.1]
} -cleanup {
- interp delete slave
+ interp delete child
} -result {dde-interp-7.1}
-test winDde-7.2 {DDE slave cleanup} -constraints dde -setup {
- interp create slave
- slave eval [list load $::ddelib Dde]
- slave eval [list dde servername -- dde-interp-7.5]
- interp delete slave
+test winDde-7.2 {DDE child cleanup} -constraints dde -setup {
+ interp create child
+ child eval [list load $::ddelib Dde]
+ child eval [list dde servername -- dde-interp-7.5]
+ interp delete child
} -body {
dde services TclEval {}
set s [dde services TclEval {}]
@@ -300,128 +299,128 @@ test winDde-7.2 {DDE slave cleanup} -constraints dde -setup {
set s
}
} -result {}
-test winDde-7.3 {DDE present in slave interp} -constraints dde -setup {
- interp create slave
- slave eval [list load $::ddelib Dde]
- slave eval [list dde servername -- dde-interp-7.3]
+test winDde-7.3 {DDE present in child interp} -constraints dde -setup {
+ interp create child
+ child eval [list load $::ddelib Dde]
+ child eval [list dde servername -- dde-interp-7.3]
} -body {
dde services TclEval dde-interp-7.3
} -cleanup {
- interp delete slave
+ interp delete child
} -result {{TclEval dde-interp-7.3}}
test winDde-7.4 {interp name collision with -force} -constraints dde -setup {
- interp create slave
- slave eval [list load $::ddelib Dde]
- slave eval [list dde servername -- dde-interp-7.4]
+ interp create child
+ child eval [list load $::ddelib Dde]
+ child eval [list dde servername -- dde-interp-7.4]
} -body {
dde servername -force -- dde-interp-7.4
} -cleanup {
- interp delete slave
+ interp delete child
} -result {dde-interp-7.4}
test winDde-7.5 {interp name collision without -force} -constraints dde -setup {
- interp create slave
- slave eval [list load $::ddelib Dde]
- slave eval [list dde servername -- dde-interp-7.5]
+ interp create child
+ child eval [list load $::ddelib Dde]
+ child eval [list dde servername -- dde-interp-7.5]
} -body {
dde servername -- dde-interp-7.5
} -cleanup {
- interp delete slave
+ interp delete child
} -result "dde-interp-7.5 #2"
# -------------------------------------------------------------------------
test winDde-8.1 {Safe DDE load} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
} -body {
- slave eval dde servername slave
+ child eval dde servername child
} -cleanup {
- interp delete slave
+ interp delete child
} -returnCodes error -result {invalid command name "dde"}
test winDde-8.2 {Safe DDE set servername} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
} -body {
- slave invokehidden dde servername slave
-} -cleanup {interp delete slave} -result {slave}
+ child invokehidden dde servername child
+} -cleanup {interp delete child} -result {child}
test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave invokehidden dde servername slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child invokehidden dde servername child
} -body {
- catch {dde eval slave set a 1} msg
-} -cleanup {interp delete slave} -result {1}
+ catch {dde eval child set a 1} msg
+} -cleanup {interp delete child} -result {1}
test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave invokehidden dde servername slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child invokehidden dde servername child
} -body {
- slave eval set a 1
- dde execute TclEval slave {set a 2}
- slave eval set a
-} -cleanup {interp delete slave} -result 1
+ child eval set a 1
+ dde execute TclEval child {set a 2}
+ child eval set a
+} -cleanup {interp delete child} -result 1
test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave invokehidden dde servername slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child invokehidden dde servername child
} -body {
- slave eval set a 1
- dde request TclEval slave a
+ child eval set a 1
+ dde request TclEval child a
} -cleanup {
- interp delete slave
+ interp delete child
} -returnCodes error -result {remote server cannot handle this command}
test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
} -body {
- slave invokehidden dde servername -handler DDEACCEPT slave
-} -cleanup {interp delete slave} -result slave
+ child invokehidden dde servername -handler DDEACCEPT child
+} -cleanup {interp delete child} -result child
test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
- slave invokehidden dde servername -handler DDEACCEPT slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ child invokehidden dde servername -handler DDEACCEPT child
} -body {
- dde eval slave set x 1
-} -cleanup {interp delete slave} -result {set x 1}
+ dde eval child set x 1
+} -cleanup {interp delete child} -result {set x 1}
test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
- slave invokehidden dde servername -handler DDEACCEPT slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+ child invokehidden dde servername -handler DDEACCEPT child
} -body {
set s "c:\\Program Files\\Microsoft Visual Studio\\"
- dde eval slave $s
- string equal [slave eval set DDECMD] $s
-} -cleanup {interp delete slave} -result 1
+ dde eval child $s
+ string equal [child eval set DDECMD] $s
+} -cleanup {interp delete child} -result 1
test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
- slave invokehidden dde servername -handler DDEACCEPT slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
+ child invokehidden dde servername -handler DDEACCEPT child
} -body {
- dde eval slave set \xe1 1
- slave eval set \xe1
-} -cleanup {interp delete slave} -result 1
+ dde eval child set \xe1 1
+ child eval set \xe1
+} -cleanup {interp delete child} -result 1
test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
- slave invokehidden dde servername -handler DDEACCEPT slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
+ child invokehidden dde servername -handler DDEACCEPT child
} -body {
- dde eval slave [list set x 1]
- slave eval set x
-} -cleanup {interp delete slave} -result 1
+ dde eval child [list set x 1]
+ child eval set x
+} -cleanup {interp delete child} -result 1
test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup {
- interp create -safe slave
- slave invokehidden load $::ddelib Dde
- slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
- slave invokehidden dde servername -handler DDEACCEPT slave
+ interp create -safe child
+ child invokehidden load $::ddelib Dde
+ child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
+ child invokehidden dde servername -handler DDEACCEPT child
} -body {
- dde eval slave [list [list set x 1]]
- slave eval set x
-} -cleanup {interp delete slave} -returnCodes error -result {invalid command name "set x 1"}
+ dde eval child [list [list set x 1]]
+ child eval set x
+} -cleanup {interp delete child} -returnCodes error -result {invalid command name "set x 1"}
# -------------------------------------------------------------------------
@@ -481,7 +480,7 @@ test winDde-9.4 {External safe DDE check null data passing} -constraints {dde st
# -------------------------------------------------------------------------
#cleanup
-#catch {interp delete $slave}; # ensure we clean up the slave.
+#catch {interp delete $child}; # ensure we clean up the child.
file delete -force $::scriptName
::tcltest::cleanupTests
return
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 2bce77c..ef62cec 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -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/tests/winFile.test b/tests/winFile.test
index b288063..d8d1b7c 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -10,11 +10,10 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[catch {package require tcltest 2.0.2}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
- return
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
-namespace import -force ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/winNotify.test b/tests/winNotify.test
index 3e9aa29..0433b4a 100644
--- a/tests/winNotify.test
+++ b/tests/winNotify.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 7e01c5f..0263823 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -12,8 +12,10 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest
-namespace import -force ::tcltest::*
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+}
unset -nocomplain path
catch {
diff --git a/tests/winTime.test b/tests/winTime.test
index dbaa14c..19e4c58 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -10,8 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 2ecbdfa..017193b 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
diff --git a/tests/zlib.test b/tests/zlib.test
index c2f7825..1461c43 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -920,7 +920,7 @@ test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
rename zlibRead {}
} -result {error {invalid block type}}
-test zlib-11.1 "Bug #3390073: mis-appled gzip filtering" -setup {
+test zlib-11.1 "Bug #3390073: mis-applied gzip filtering" -setup {
set file [makeFile {} test.input]
} -constraints zlib -body {
set f [open $file wb]
@@ -934,7 +934,7 @@ test zlib-11.1 "Bug #3390073: mis-appled gzip filtering" -setup {
} -cleanup {
removeFile $file
} -result {1000 0}
-test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
+test zlib-11.2 "Bug #3390073: mis-applied gzip filtering" -setup {
set file [makeFile {} test.input]
} -constraints zlib -body {
set f [open $file wb]
@@ -1005,6 +1005,86 @@ test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup {
removeFile $filesrc
removeFile $filedst
} -result 56
+
+set zlibbinf ""
+proc _zlibbinf {} {
+ # inlined zlib.bin file creator:
+ variable zlibbinf
+ if {$zlibbinf eq ""} {
+ set zlibbinf [makeFile {} test-zlib-13.bin]
+ set f [open $zlibbinf wb]
+ puts -nonewline $f [zlib decompress [binary decode base64 {
+ eJx7e+6s1+EAgYaLjK3ratptGmOck0vT/y/ZujHAd0qJelDBXfUPJ3tfrtLbpX+wOOFHmtn03/tizm
+ /+tXROXU3d203b79p5X6/0cvUyFzTsqOj4sa9r8SrZI5zT7265e2Xzq595Fb9LbpgffVy7cZaJ/d15
+ 4U9L7LLM2vdqut8+aSU/r6q9Ltv6+T9mBhTgIK97bH33m/O1C1eBwf9FDKNgaIDaj9wA+5hToA==
+ }]]
+ close $f
+ }
+ return $zlibbinf
+}
+test zlib-13.1 {Ticket [8af92dfb66] - zlib stream mis-expansion} -constraints zlib -setup {
+ set pathin [_zlibbinf]
+ set chanin [open $pathin rb]
+ set pathout [makeFile {} test-zlib-13.deflated]
+ set chanout [open $pathout wb]
+ zlib push inflate $chanin
+ fcopy $chanin $chanout
+ close $chanin
+ close $chanout
+} -body {
+ file size $pathout
+} -cleanup {
+ removeFile $pathout
+ unset chanin pathin chanout pathout
+} -result 458752
+
+test zlib-13.2 {Ticket [f70ce1fead] - zlib multi-stream expansion} -constraints zlib -setup {
+ # Start from the basic asset
+ set pathin [_zlibbinf]
+ set chanin [open $pathin rb]
+ # Create a multi-stream by copying the asset twice into it.
+ set pathout [makeFile {} test-zlib-13.multi]
+ set chanout [open $pathout wb]
+ fcopy $chanin $chanout
+ seek $chanin 0 start
+ fcopy $chanin $chanout
+ close $chanin
+ close $chanout
+ # The multi-stream file shall be our input
+ set pathin $pathout
+ set chanin [open $pathin rb]
+ # And our destinations
+ set pathout1 [makeFile {} test-zlib-13.multi-1]
+ set pathout2 [makeFile {} test-zlib-13.multi-2]
+} -body {
+ # Decode first stream
+ set chanout [open $pathout1 wb]
+ zlib push inflate $chanin
+ fcopy $chanin $chanout
+ chan pop $chanin
+ close $chanout
+ # Decode second stream
+ set chanout [open $pathout2 wb]
+ zlib push inflate $chanin
+ fcopy $chanin $chanout
+ chan pop $chanin
+ close $chanout
+ #
+ list [file size $pathout1] [file size $pathout2]
+} -cleanup {
+ close $chanin
+ removeFile $pathout
+ removeFile $pathout1
+ removeFile $pathout2
+ unset chanin pathin chanout pathout pathout1 pathout2
+} -result {458752 458752}
+
+if {$zlibbinf ne ""} {
+ removeFile $zlibbinf
+}
+unset zlibbinf
+rename _zlibbinf {}
+
::tcltest::cleanupTests
return
diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl
index 6d147ac..d560b98 100755
--- a/tools/checkLibraryDoc.tcl
+++ b/tools/checkLibraryDoc.tcl
@@ -69,6 +69,7 @@ set StructList {
Tk_GeomMgr \
Tk_Image \
Tk_ImageMaster \
+ Tk_ImageModel \
Tk_ImageType \
Tk_Item \
Tk_ItemType \
diff --git a/tools/encoding/Makefile b/tools/encoding/Makefile
index 4c10673..361239e 100644
--- a/tools/encoding/Makefile
+++ b/tools/encoding/Makefile
@@ -1,5 +1,5 @@
#
-# This file is a Makefile to compile all the encoding files.
+# This file is a Makefile to compile all the encoding files.
#
# Run "make" to compile all the encoding files (*.txt,*.esc) into the
# format that Tcl can use (*.enc). It is your responsibility to move the
@@ -26,16 +26,16 @@
# specifically excludes the right to re-distribute this file directly
# to third parties or other organizations whether for profit or not.
#
-# In other words: Don't put this file on the Internet. People who want to
+# In other words: Don't put this file on the Internet. People who want to
# get it over the Internet should do so directly from ftp://unicode.org. They
# can therefore be assured of getting the most recent and accurate version.
#
#----------------------------------------------------------------------------
#
# The txt2enc program built by this makefile is used to compile individual
-# .txt files into .enc files, the format that Tcl understands for encoding
+# .txt files into .enc files, the format that Tcl understands for encoding
# files. This compilation to a different format is allowed by the above
-# restriction.
+# restriction.
#
# The files shiftjis.txt and jis0208.txt were modified from the original
# ones provided on the Unicode CD. The double-width backslash character
@@ -53,7 +53,7 @@
# SCCS: @(#) Makefile 1.1 98/01/28 11:41:36
#
-EUC_ENCODINGS = euc-cn.txt euc-kr.txt euc-jp.txt
+EUC_ENCODINGS = euc-cn.txt euc-kr.txt euc-jp.txt
encodings: clean txt2enc $(EUC_ENCODINGS)
@echo Compiling encoding files.
@@ -69,7 +69,7 @@ encodings: clean txt2enc $(EUC_ENCODINGS)
echo $$enc; \
./txt2enc -e 0 -u 1 $$p > $$enc; \
done
- @echo
+ @echo
@echo Compiling special versions of encoding files.
@for p in ascii.txt; do \
enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \
diff --git a/tools/encoding/big5.txt b/tools/encoding/big5.txt
index 5cc9e81..f21484a 100644
--- a/tools/encoding/big5.txt
+++ b/tools/encoding/big5.txt
@@ -41,7 +41,7 @@
# BIG5 characters map into Unicode.
#
# WARNING! It is currently impossible to provide round-trip compatibility
-# between BIG5 and Unicode.
+# between BIG5 and Unicode.
#
# A number of characters are not currently mapped because
# of conflicts with other mappings. They are as follows:
@@ -58,8 +58,8 @@
#
# We currently map all of these characters to U+FFFD REPLACEMENT CHARACTER.
# It is also possible to map these characters to their duplicates, or to
-# the user zone.
-#
+# the user zone.
+#
# Notes:
#
# 1. In addition to the above, there is some uncertainty about the
@@ -72,13 +72,13 @@
# 0xA3BC. This character occurs within the Big Five block of tone marks
# for bopomofo and is intended to be the tone mark for the first tone in
# Mandarin Chinese. We have selected the mapping U+02C9 MODIFIER LETTER
-# MACRON (Mandarin Chinese first tone) to reflect this semantic.
+# MACRON (Mandarin Chinese first tone) to reflect this semantic.
# However, because bopomofo uses the absense of a tone mark to indicate
# the first Mandarin tone, most implementations of Big Five represent
# this character with a blank space, and so a mapping such as U+2003 EM SPACE
-# might be preferred.
-#
-#
+# might be preferred.
+#
+#
#
# Format: Three tab-separated columns
# Column #1 is the BIG5 code (in hex as 0xXXXX)
diff --git a/tools/encoding/jis0212.txt b/tools/encoding/jis0212.txt
index b6d4cb2..316d28e 100644
--- a/tools/encoding/jis0212.txt
+++ b/tools/encoding/jis0212.txt
@@ -61,7 +61,7 @@
#
# 1. JIS X 0212 apparently unified the following two symbols
# into a single character at 0x2922:
-#
+#
# LATIN CAPITAL LETTER D WITH STROKE
# LATIN CAPITAL LETTER ETH
#
@@ -71,7 +71,7 @@
# 0x2922 and 0x2942 are intended to be a capital/small pair.
# Consequently, in the Unicode mapping, 0x2922 is treated as
# LATIN CAPITAL LETTER D WITH STROKE.
-#
+#
0x222F 0x02D8 # BREVE
0x2230 0x02C7 # CARON (Mandarin Chinese third tone)
0x2231 0x00B8 # CEDILLA
diff --git a/tools/encoding/ksc5601.txt b/tools/encoding/ksc5601.txt
index 5c6e7dc..c5a6dd1 100644
--- a/tools/encoding/ksc5601.txt
+++ b/tools/encoding/ksc5601.txt
@@ -5,7 +5,7 @@
# BUT the mapping table between UHC(Microsoft Unified Hangul Code)
# and Unicode 2.0. Hence, in this pacakge, I renamed it as UHC.TXT
#
-# The Unix command used is
+# The Unix command used is
# egrep '^0x' < KSC5601.TXT | \
# egrep -v '^0x([8-9]...|A0..|..[4-9].|..A0)' | perl tab.pl
#
@@ -26,8 +26,8 @@
# Column #3 : the Unicode name (following a comment sign, '#')
# The number of characters enumerated in this table is 8824, the
# as listed in KS C 5601-987
-#
-#
+#
+#
# The entries are in KS C 5601-1987 order
# You can use the following algorithms to convert the hex form
# of KS C 5601 to other forms
diff --git a/tools/encoding/macCentEuro.txt b/tools/encoding/macCentEuro.txt
index e6507d6..bf424c1 100644
--- a/tools/encoding/macCentEuro.txt
+++ b/tools/encoding/macCentEuro.txt
@@ -34,7 +34,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/macCroatian.txt b/tools/encoding/macCroatian.txt
index 2d66b6d..538eda3 100644
--- a/tools/encoding/macCroatian.txt
+++ b/tools/encoding/macCroatian.txt
@@ -36,7 +36,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/macCyrillic.txt b/tools/encoding/macCyrillic.txt
index b58bb83..695dade 100644
--- a/tools/encoding/macCyrillic.txt
+++ b/tools/encoding/macCyrillic.txt
@@ -37,7 +37,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/macGreek.txt b/tools/encoding/macGreek.txt
index 28b6ea8..9783259 100644
--- a/tools/encoding/macGreek.txt
+++ b/tools/encoding/macGreek.txt
@@ -35,7 +35,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/macIceland.txt b/tools/encoding/macIceland.txt
index d28bd9d..0a0b27b 100644
--- a/tools/encoding/macIceland.txt
+++ b/tools/encoding/macIceland.txt
@@ -37,7 +37,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/macRoman.txt b/tools/encoding/macRoman.txt
index 8821f3b..7ddcf8d 100644
--- a/tools/encoding/macRoman.txt
+++ b/tools/encoding/macRoman.txt
@@ -41,7 +41,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/macTurkish.txt b/tools/encoding/macTurkish.txt
index 7b143e0..4a1ddab 100644
--- a/tools/encoding/macTurkish.txt
+++ b/tools/encoding/macTurkish.txt
@@ -34,7 +34,7 @@
# Apple makes no warranty or representation, either express or
# implied, with respect to these tables, their quality, accuracy, or
# fitness for a particular purpose. In no event will Apple be liable
-# for direct, indirect, special, incidental, or consequential damages
+# for direct, indirect, special, incidental, or consequential damages
# resulting from any defect or inaccuracy in this document or the
# accompanying tables.
#
diff --git a/tools/encoding/shiftjis.txt b/tools/encoding/shiftjis.txt
index 7db99ab..b616f85 100644
--- a/tools/encoding/shiftjis.txt
+++ b/tools/encoding/shiftjis.txt
@@ -47,7 +47,7 @@
# There is an alternative order some people might be preferred,
# where all the entries are in order of the top (or only) byte.
# This alternate order can be generated from the one given here
-# by a simple sort.
+# by a simple sort.
#
# The kanji mappings are a normative part of ISO/IEC 10646. The
# non-kanji mappings are provisional, pending definition of
diff --git a/tools/encoding/tis-620.txt b/tools/encoding/tis-620.txt
index d3656c5..8243d81 100644
--- a/tools/encoding/tis-620.txt
+++ b/tools/encoding/tis-620.txt
@@ -176,7 +176,7 @@
0xA8 0x0E08 #THAI CHARACTER CHO CHAN
0xA9 0x0E09 #THAI CHARACTER CHO CHING
0xAA 0x0E0A #THAI CHARACTER CHO CHANG
-0xAB 0x0E0B #THAI CHARACTER SO SO
+0xAB 0x0E0B #THAI CHARACTER SO SO
0xAC 0x0E0C #THAI CHARACTER CHO CHOE
0xAD 0x0E0D #THAI CHARACTER YO YING
0xAE 0x0E0E #THAI CHARACTER DO CHADA
diff --git a/tools/mkdepend.tcl b/tools/mkdepend.tcl
index ecb2206..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]} {
@@ -98,7 +98,7 @@ proc readDepends {chan} {
} else {
# don't include ourselves as a dependency of ourself.
if {![string compare $fname $target]} {continue}
- # store in an array so multiple occurances are not counted.
+ # store in an array so multiple occurrences are not counted.
set depends($target|$fname) ""
}
}
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 517360b..c81acce 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -629,6 +629,7 @@ array set remap_link_target {
Tk_Font Tk_GetFont
Tk_Image Tk_GetImage
Tk_ImageMaster Tk_GetImage
+ Tk_ImageModel Tk_GetImage
Tk_ItemType Tk_CreateItemType
Tk_Justify Tk_GetJustify
Ttk_Theme Ttk_GetTheme
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
}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 6654f25..b65cc5a 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -114,11 +114,6 @@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@
-# To disable ANSI-C procedure prototypes reverse the comment characters on the
-# following lines:
-PROTO_FLAGS =
-#PROTO_FLAGS = -DNO_PROTOTYPE
-
# If you use the setenv, putenv, or unsetenv procedures to modify environment
# variables in your application and you'd like those modifications to appear
# in the "env" Tcl variable, switch the comments on the two lines below so
@@ -282,7 +277,7 @@ VALGRINDARGS = --tool=memcheck --num-callers=24 \
STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
- ${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
+ ${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
@EXTRA_CC_SWITCHES@
CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT
@@ -292,7 +287,7 @@ APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@
LIBS = @TCL_LIBS@
DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
- ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
+ ${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
TCLSH_OBJS = tclAppInit.o
@@ -871,6 +866,7 @@ SHELL_ENV = @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@} \
TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"
${TCLTEST_EXE}: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST}
+ rm -rf $(TOP_DIR)/tests/safe-stock86.test
$(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`"
tcltest-real:
@@ -1044,16 +1040,16 @@ install-libraries: libraries
@for i in $(TOP_DIR)/library/cookiejar/*.gz; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done
- @echo "Installing package http 2.9.1 as a Tcl Module"
+ @echo "Installing package http 2.9.5 as a Tcl Module"
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
- "$(MODULE_INSTALL_DIR)/8.6/http-2.9.1.tm"
+ "$(MODULE_INSTALL_DIR)/8.6/http-2.9.5.tm"
@echo "Installing package opt 0.4.7"
@for i in $(TOP_DIR)/library/opt/*.tcl; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done
- @echo "Installing package msgcat 1.7.0 as a Tcl Module"
+ @echo "Installing package msgcat 1.7.1 as a Tcl Module"
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
- "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.0.tm"
+ "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"
@echo "Installing package tcltest 2.5.3 as a Tcl Module"
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
"$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.3.tm"
@@ -1531,7 +1527,7 @@ tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
- $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip \
+ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \
$(GENERIC_DIR)/tclZipfs.c
tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
@@ -2213,9 +2209,9 @@ rpm: all
-rm -rf RPMS THIS.TCL.SPEC
#
-# Target to create a proper Tcl distribution from information in the master
-# source directory. DISTDIR must be defined to indicate where to put the
-# distribution. DISTDIR must be an absolute path name.
+# Target to create a proper Tcl distribution from information in the
+# source directory. DISTDIR must be defined to indicate where to put
+# the distribution. DISTDIR must be an absolute path name.
#
DISTROOT = /tmp/dist
@@ -2232,10 +2228,15 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
cd $(MAC_OSX_DIR); autoheader; touch $@
-dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in \
- $(MAC_OSX_DIR)/configure genstubs dist-packages ${NATIVE_TCLSH}
+$(TOP_DIR)/manifest.uuid:
+ printf "git." >$(TOP_DIR)/manifest.uuid
+ git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid
+
+dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \
+ $(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH}
rm -rf $(DISTDIR)
mkdir -p $(DISTDIR)/unix
+ cp -p $(TOP_DIR)/manifest.uuid $(DISTDIR)
cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
chmod 664 $(DISTDIR)/unix/Makefile.in
diff --git a/unix/configure b/unix/configure
index 874c945..d3a4856 100755
--- a/unix/configure
+++ b/unix/configure
@@ -5038,7 +5038,7 @@ fi
CFLAGS_OPTIMIZE=-O2
CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
case "${CC}" in
- *++)
+ *++|*++-*)
;;
*)
CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
@@ -5311,7 +5311,7 @@ fi
LD_SEARCH_FLAGS=""
;;
CYGWIN_*)
- SHLIB_CFLAGS=""
+ SHLIB_CFLAGS="-fno-common"
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
DL_OBJS="tclLoadDl.o"
@@ -5694,7 +5694,7 @@ fi
fi
;;
Linux*|GNU*|NetBSD-Debian)
- SHLIB_CFLAGS="-fPIC"
+ SHLIB_CFLAGS="-fPIC -fno-common"
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE="-O2"
@@ -5830,7 +5830,6 @@ fi
;;
DragonFly-*|FreeBSD-*)
# This configuration from FreeBSD Ports.
- SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@"
SHLIB_SUFFIX=".so"
@@ -6218,7 +6217,6 @@ fi
QNX-6*)
# QNX RTP
# This may work for all QNX, but it was only reported for v6.
- SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
@@ -6562,9 +6560,12 @@ fi
AIX-*) ;;
BSD/OS*) ;;
CYGWIN_*) ;;
- IRIX*) ;;
- NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
+ HP_UX*) ;;
Darwin-*) ;;
+ IRIX*) ;;
+ Linux*|GNU*) ;;
+ NetBSD-*|OpenBSD-*) ;;
+ OSF1-V*) ;;
SCO_SV-3.2*) ;;
*) SHLIB_CFLAGS="-fPIC" ;;
esac
@@ -8893,8 +8894,10 @@ else
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+
+#include <stdlib.h>
+#include <string.h>
int main() {
- extern int strstr();
exit(strstr("\0test", "test") ? 1 : 0);
}
_ACEOF
@@ -8952,8 +8955,10 @@ else
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+
+#include <stdlib.h>
+#include <string.h>
int main() {
- extern int strtoul();
char *term, *string = "0";
exit(strtoul(string,&term,0) != 0 || term != string+1);
}
@@ -9510,6 +9515,7 @@ else
/* end confdefs.h. */
#include <stdlib.h>
+ #include <string.h>
#define OURVAR "havecopy=yes"
int main (int argc, char *argv[])
{
diff --git a/unix/configure.ac b/unix/configure.ac
index dd28f9a..d480fb7 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -388,7 +388,6 @@ AC_CHECK_FUNC(memmove, , [
#--------------------------------------------------------------------
SC_TCL_CHECK_BROKEN_FUNC(strstr, [
- extern int strstr();
exit(strstr("\0test", "test") ? 1 : 0);
])
@@ -399,7 +398,6 @@ SC_TCL_CHECK_BROKEN_FUNC(strstr, [
#--------------------------------------------------------------------
SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
- extern int strtoul();
char *term, *string = "0";
exit(strtoul(string,&term,0) != 0 || term != string+1);
])
@@ -545,6 +543,7 @@ fi
AC_CACHE_CHECK([for a putenv() that copies the buffer], tcl_cv_putenv_copy, [
AC_TRY_RUN([
#include <stdlib.h>
+ #include <string.h>
#define OURVAR "havecopy=yes"
int main (int argc, char *argv[])
{
diff --git a/unix/installManPage b/unix/installManPage
index 06f4f2b..baae3aa 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -114,7 +114,7 @@ SrcDir=`dirname $ManPage`
### Process Page to Create Target Pages
###
-Specials="DString Thread Notifier RegExp library packagens pkgMkIndex safesock"
+Specials="DString Thread Notifier RegExp library packagens pkgMkIndex safesock FindPhoto FontId MeasureChar"
for n in $Specials; do
if [ "$Name" = "$n" ] ; then
Names="$n $Names"
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 0a2920b..056cf1f 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -968,7 +968,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CFLAGS_OPTIMIZE=-O2
CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
case "${CC}" in
- *++)
+ *++|*++-*)
;;
*)
CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
@@ -1084,7 +1084,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LD_SEARCH_FLAGS=""
;;
CYGWIN_*)
- SHLIB_CFLAGS=""
+ SHLIB_CFLAGS="-fno-common"
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
DL_OBJS="tclLoadDl.o"
@@ -1269,7 +1269,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
])
;;
Linux*|GNU*|NetBSD-Debian)
- SHLIB_CFLAGS="-fPIC"
+ SHLIB_CFLAGS="-fPIC -fno-common"
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE="-O2"
@@ -1364,7 +1364,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
;;
DragonFly-*|FreeBSD-*)
# This configuration from FreeBSD Ports.
- SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
SHLIB_SUFFIX=".so"
@@ -1558,7 +1557,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
QNX-6*)
# QNX RTP
# This may work for all QNX, but it was only reported for v6.
- SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
@@ -1786,9 +1784,12 @@ dnl # preprocessing tests use only CPPFLAGS.
AIX-*) ;;
BSD/OS*) ;;
CYGWIN_*) ;;
- IRIX*) ;;
- NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
+ HP_UX*) ;;
Darwin-*) ;;
+ IRIX*) ;;
+ Linux*|GNU*) ;;
+ NetBSD-*|OpenBSD-*) ;;
+ OSF1-V*) ;;
SCO_SV-3.2*) ;;
*) SHLIB_CFLAGS="-fPIC" ;;
esac])
@@ -2476,7 +2477,10 @@ AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[
AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0)
if test ["$tcl_ok"] = 1; then
AC_CACHE_CHECK([proper ]$1[ implementation], [tcl_cv_]$1[_unbroken],
- AC_TRY_RUN([[int main() {]$2[}]],[tcl_cv_]$1[_unbroken]=ok,
+ AC_TRY_RUN([[
+#include <stdlib.h>
+#include <string.h>
+int main() {]$2[}]],[tcl_cv_]$1[_unbroken]=ok,
[tcl_cv_]$1[_unbroken]=broken,[tcl_cv_]$1[_unbroken]=unknown))
if test ["$tcl_cv_]$1[_unbroken"] = "ok"; then
tcl_ok=1
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index fb29a32..1328d51 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -4,6 +4,9 @@
#ifndef _TCLCONFIG
#define _TCLCONFIG
+/* Define if building universal (internal helper macro) */
+#undef AC_APPLE_UNIVERSAL_BUILD
+
/* Is gettimeofday() actually declared in <sys/time.h>? */
#undef GETTOD_NOT_DECLARED
@@ -232,10 +235,10 @@
/* Is 'struct stat64' in <sys/stat.h>? */
#undef HAVE_STRUCT_STAT64
-/* Define to 1 if `st_blksize' is member of `struct stat'. */
+/* Define to 1 if `st_blksize' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLKSIZE
-/* Define to 1 if `st_blocks' is member of `struct stat'. */
+/* Define to 1 if `st_blocks' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLOCKS
/* Define to 1 if you have the <sys/epoll.h> header file. */
@@ -307,6 +310,9 @@
/* No Compiler support for module scope symbols */
#undef MODULE_SCOPE
+/* Default libtommath precision. */
+#undef MP_PREC
+
/* Is no debugging enabled? */
#undef NDEBUG
@@ -382,6 +388,9 @@
/* Define to the one symbol short name of this package. */
#undef PACKAGE_TARNAME
+/* Define to the home page for this package. */
+#undef PACKAGE_URL
+
/* Define to the version of this package. */
#undef PACKAGE_VERSION
@@ -433,6 +442,9 @@
/* What type should be used to define wide integers? */
#undef TCL_WIDE_INT_TYPE
+/* Tcl with external libtommath */
+#undef TCL_WITH_EXTERNAL_TOMMATH
+
/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME
@@ -451,9 +463,17 @@
/* Should we use vfork() instead of fork()? */
#undef USE_VFORK
-/* Define to 1 if your processor stores words with the most significant byte
- first (like Motorola and SPARC, unlike Intel and VAX). */
-#undef WORDS_BIGENDIAN
+/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
+ significant byte first (like Motorola and SPARC, unlike Intel). */
+#if defined AC_APPLE_UNIVERSAL_BUILD
+# if defined __BIG_ENDIAN__
+# define WORDS_BIGENDIAN 1
+# endif
+#else
+# ifndef WORDS_BIGENDIAN
+# undef WORDS_BIGENDIAN
+# endif
+#endif
/* Are we building with zipfs enabled? */
#undef ZIPFS_BUILD
@@ -511,7 +531,7 @@
/* Define to `int' if <sys/types.h> does not define. */
#undef pid_t
-/* Define to `unsigned' if <sys/types.h> does not define. */
+/* Define to `unsigned int' if <sys/types.h> does not define. */
#undef size_t
/* Define as int if socklen_t is not available */
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index 743b5a5..f2ac768 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -23,7 +23,8 @@ TCL_DEFS='@DEFS@'
# TCL_DBGX used to be used to distinguish debug vs. non-debug builds.
# This was a righteous pain so the core doesn't do that any more.
-TCL_DBGX=
+# DEPRECATED, will be removed in Tcl 9!
+TCL_DBGX=''
# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 7717721..55c5fa9 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -384,7 +384,7 @@ TclpGetGrNam(
if (tsdPtr->gbuflen < 1) {
tsdPtr->gbuflen = 1024;
}
- tsdPtr->gbuf = (char*)ckalloc(tsdPtr->gbuflen);
+ tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen);
Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
}
while (1) {
@@ -464,7 +464,7 @@ TclpGetGrGid(
if (tsdPtr->gbuflen < 1) {
tsdPtr->gbuflen = 1024;
}
- tsdPtr->gbuf = (char*)ckalloc(tsdPtr->gbuflen);
+ tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen);
Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
}
while (1) {
@@ -903,7 +903,7 @@ CopyArray(
return -1;
}
- newBuffer = (char **) buf;
+ newBuffer = (char **)buf;
p = buf + len;
for (j = 0; j < i; j++) {
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index f5d8fee..b67d91d 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -874,7 +874,7 @@ TclpSetVariables(
#ifdef __CYGWIN__
unameOK = 1;
if (!osInfoInitialized) {
- HANDLE handle = GetModuleHandleW(L"NTDLL");
+ void *handle = GetModuleHandleW(L"NTDLL");
int(__stdcall *getversion)(void *) =
(int(__stdcall *)(void *))GetProcAddress(handle, "RtlGetVersion");
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 795c62c..92399f4 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -169,23 +169,23 @@ static Tcl_ThreadDataKey dataKey;
#endif /* TCL_NO_DEPRECATED */
/*
- * masterLock is used to serialize creation of mutexes, condition variables,
+ * globalLock is used to serialize creation of mutexes, condition variables,
* and thread local storage. This is the only place that can count on the
* ability to statically initialize the mutex.
*/
-static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;
+static pthread_mutex_t globalLock = PTHREAD_MUTEX_INITIALIZER;
/*
* initLock is used to serialize initialization and finalization of Tcl. It
- * cannot use any dyamically allocated storage.
+ * cannot use any dynamically allocated storage.
*/
static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;
/*
* allocLock is used by Tcl's version of malloc for synchronization. For
- * obvious reasons, cannot use any dyamically allocated storage.
+ * obvious reasons, cannot use any dynamically allocated storage.
*/
static PMutex allocLock;
@@ -236,7 +236,7 @@ TclpThreadCreate(
#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
if (stackSize != TCL_THREAD_STACK_DEFAULT) {
- pthread_attr_setstacksize(&attr, (size_t) stackSize);
+ pthread_attr_setstacksize(&attr, stackSize);
#ifdef TCL_THREAD_STACK_MIN
} else {
/*
@@ -266,12 +266,12 @@ TclpThreadCreate(
}
if (pthread_create(&theThread, &attr,
- (void * (*)(void *))(void *)proc, (void *) clientData) &&
+ (void * (*)(void *))(void *)proc, (void *)clientData) &&
pthread_create(&theThread, NULL,
- (void * (*)(void *))(void *)proc, (void *) clientData)) {
+ (void * (*)(void *))(void *)proc, (void *)clientData)) {
result = TCL_ERROR;
} else {
- *idPtr = (Tcl_ThreadId) theThread;
+ *idPtr = (Tcl_ThreadId)theThread;
result = TCL_OK;
}
pthread_attr_destroy(&attr);
@@ -423,7 +423,7 @@ TclFinalizeLock(void)
/*
* You do not need to destroy mutexes that were created with the
* PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
- * destruction: masterLock, allocLock, and initLock.
+ * destruction: globalLock, allocLock, and initLock.
*/
pthread_mutex_unlock(&initLock);
@@ -458,7 +458,7 @@ TclpInitUnlock(void)
/*
*----------------------------------------------------------------------
*
- * TclpMasterLock
+ * TclpGlobalLock
*
* This procedure is used to grab a lock that serializes creation and
* finalization of serialization objects. This interface is only needed
@@ -471,23 +471,23 @@ TclpInitUnlock(void)
* None.
*
* Side effects:
- * Acquire the master mutex.
+ * Acquire the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterLock(void)
+TclpGlobalLock(void)
{
#if TCL_THREADS
- pthread_mutex_lock(&masterLock);
+ pthread_mutex_lock(&globalLock);
#endif
}
/*
*----------------------------------------------------------------------
*
- * TclpMasterUnlock
+ * TclpGlobalUnlock
*
* This procedure is used to release a lock that serializes creation and
* finalization of synchronization objects.
@@ -496,16 +496,16 @@ TclpMasterLock(void)
* None.
*
* Side effects:
- * Release the master mutex.
+ * Release the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterUnlock(void)
+TclpGlobalUnlock(void)
{
#if TCL_THREADS
- pthread_mutex_unlock(&masterLock);
+ pthread_mutex_unlock(&globalLock);
#endif
}
@@ -515,7 +515,7 @@ TclpMasterUnlock(void)
* Tcl_GetAllocMutex
*
* This procedure returns a pointer to a statically initialized mutex for
- * use by the memory allocator. The alloctor must use this lock, because
+ * use by the memory allocator. The allocator must use this lock, because
* all other locks are allocated...
*
* Results:
@@ -571,10 +571,10 @@ Tcl_MutexLock(
PMutex *pmutexPtr;
if (*mutexPtr == NULL) {
- pthread_mutex_lock(&masterLock);
+ pthread_mutex_lock(&globalLock);
if (*mutexPtr == NULL) {
/*
- * Double inside master lock check to avoid a race condition.
+ * Double inside global lock check to avoid a race condition.
*/
pmutexPtr = (PMutex *)ckalloc(sizeof(PMutex));
@@ -582,7 +582,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex) pmutexPtr;
TclRememberMutex(mutexPtr);
}
- pthread_mutex_unlock(&masterLock);
+ pthread_mutex_unlock(&globalLock);
}
pmutexPtr = *((PMutex **) mutexPtr);
PMutexLock(pmutexPtr);
@@ -622,7 +622,7 @@ Tcl_MutexUnlock(
* This procedure is invoked to clean up one mutex. This is only safe to
* call at the end of time.
*
- * This assumes the Master Lock is held.
+ * This assumes the Global Lock is held.
*
* Results:
* None.
@@ -679,7 +679,7 @@ Tcl_ConditionWait(
struct timespec ptime;
if (*condPtr == NULL) {
- pthread_mutex_lock(&masterLock);
+ pthread_mutex_lock(&globalLock);
/*
* Double check inside mutex to avoid race, then initialize condition
@@ -692,10 +692,10 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
}
- pthread_mutex_unlock(&masterLock);
+ pthread_mutex_unlock(&globalLock);
}
- pmutexPtr = *((PMutex **) mutexPtr);
- pcondPtr = *((pthread_cond_t **) condPtr);
+ pmutexPtr = *((PMutex **)mutexPtr);
+ pcondPtr = *((pthread_cond_t **)condPtr);
if (timePtr == NULL) {
PCondWait(pcondPtr, pmutexPtr);
} else {
@@ -737,7 +737,7 @@ void
Tcl_ConditionNotify(
Tcl_Condition *condPtr)
{
- pthread_cond_t *pcondPtr = *((pthread_cond_t **) condPtr);
+ pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);
if (pcondPtr != NULL) {
pthread_cond_broadcast(pcondPtr);
@@ -756,7 +756,7 @@ Tcl_ConditionNotify(
* This procedure is invoked to clean up a condition variable. This is
* only safe to call at the end of time.
*
- * This assumes the Master Lock is held.
+ * This assumes the Global Lock is held.
*
* Results:
* None.
@@ -771,7 +771,7 @@ void
TclpFinalizeCondition(
Tcl_Condition *condPtr)
{
- pthread_cond_t *pcondPtr = *(pthread_cond_t **) condPtr;
+ pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;
if (pcondPtr != NULL) {
pthread_cond_destroy(pcondPtr);
@@ -860,7 +860,7 @@ void
TclpFreeAllocMutex(
Tcl_Mutex *mutex) /* The alloc mutex to free. */
{
- AllocMutex *lockPtr = (AllocMutex *) mutex;
+ AllocMutex *lockPtr = (AllocMutex *)mutex;
if (!lockPtr) {
return;
@@ -943,22 +943,22 @@ TclpThreadDeleteKey(
}
void
-TclpThreadSetMasterTSD(
+TclpThreadSetGlobalTSD(
void *tsdKeyPtr,
void *ptr)
{
pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;
if (pthread_setspecific(*ptkeyPtr, ptr)) {
- Tcl_Panic("unable to set master TSD value");
+ Tcl_Panic("unable to set global TSD value");
}
}
void *
-TclpThreadGetMasterTSD(
+TclpThreadGetGlobalTSD(
void *tsdKeyPtr)
{
- pthread_key_t *ptkeyPtr = (pthread_key_t*)tsdKeyPtr;
+ pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;
return pthread_getspecific(*ptkeyPtr);
}
diff --git a/win/Makefile.in b/win/Makefile.in
index 5024a82..b039edd 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -70,9 +70,6 @@ MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
# Directory in which to install manual entries for the built-in Tcl commands:
MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
-# Libraries built with optimization switches have this additional extension
-TCL_DBGX = @TCL_DBGX@
-
# warning flags
CFLAGS_WARNING = @CFLAGS_WARNING@
@@ -257,7 +254,7 @@ ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@
CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
-${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} -DMP_PREC=4 \
+${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
@@ -599,6 +596,7 @@ ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
@$(RM) ${TEST_EXE_FILE}
+ @$(RM) $(ROOT_DIR_NATIVE)/tests/safe-stock86.test
$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest
@@ -878,15 +876,15 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done;
- @echo "Installing package http 2.9.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.1.tm";
+ @echo "Installing package http 2.9.5 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.5.tm";
@echo "Installing package opt 0.4.7";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.7.0 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.0.tm";
+ @echo "Installing package msgcat 1.7.1 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
@echo "Installing package tcltest 2.5.3 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.3.tm";
@echo "Installing package platform 1.0.14 as a Tcl Module";
diff --git a/win/configure b/win/configure
index e9ba659..f099510 100755
--- a/win/configure
+++ b/win/configure
@@ -669,7 +669,6 @@ EXTRA_CFLAGS
CFG_TCL_EXPORT_FILE_SUFFIX
CFG_TCL_UNSHARED_LIB_SUFFIX
CFG_TCL_SHARED_LIB_SUFFIX
-TCL_DBGX
TCL_BIN_DIR
TCL_SRC_DIR
TCL_DLL_FILE
@@ -4182,7 +4181,7 @@ $as_echo_n "checking compiler flags... " >&6; }
$as_echo "using static flags" >&6; }
runtime=
LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
+ EXESUFFIX="s.exe"
else
# dynamic
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
@@ -4197,7 +4196,7 @@ $as_echo "using shared flags" >&6; }
runtime=
# Add SHLIB_LD_LIBS to the Make rule, not here.
- EXESUFFIX="\${DBGX}.exe"
+ EXESUFFIX=".exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
# Link with gcc since ld does not link to default libs like
@@ -4208,9 +4207,9 @@ $as_echo "using shared flags" >&6; }
-Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
+ DLLSUFFIX=".dll"
+ LIBSUFFIX=".a"
+ LIBFLAGSUFFIX=""
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
@@ -4300,7 +4299,7 @@ $as_echo " Using 64-bit $MACHINE mode" >&6; }
$as_echo "using static flags" >&6; }
runtime=-MT
LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
+ EXESUFFIX="s.exe"
else
# dynamic
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
@@ -4308,7 +4307,7 @@ $as_echo "using shared flags" >&6; }
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
LIBRARIES="\${SHARED_LIBRARIES}"
- EXESUFFIX="\${DBGX}.exe"
+ EXESUFFIX=".exe"
case "x`echo \${VisualStudioVersion}`" in
x1[4-9]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
@@ -4320,9 +4319,9 @@ $as_echo "using shared flags" >&6; }
MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
+ DLLSUFFIX=".dll"
+ LIBSUFFIX=".lib"
+ LIBFLAGSUFFIX=""
if test "$do64bit" != "no" ; then
case "$do64bit" in
@@ -5176,7 +5175,6 @@ fi
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
- DBGX=""
$as_echo "#define NDEBUG 1" >>confdefs.h
@@ -5188,7 +5186,6 @@ $as_echo "no" >&6; }
else
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
- DBGX=g
if test "$tcl_ok" = "yes"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
$as_echo "yes (standard debugging)" >&6; }
@@ -5223,8 +5220,6 @@ $as_echo "enabled $tcl_ok debugging" >&6; }
fi
-TCL_DBGX=${DBGX}
-
#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------
@@ -5290,10 +5285,6 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------
-TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
-TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-
eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
@@ -5312,11 +5303,9 @@ eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
-
-eval "DLLSUFFIX=${DLLSUFFIX}"
-eval "LIBPREFIX=${LIBPREFIX}"
-eval "LIBSUFFIX=${LIBSUFFIX}"
-eval "EXESUFFIX=${EXESUFFIX}"
+TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
@@ -5328,17 +5317,9 @@ CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
#--------------------------------------------------------------------
if test ${SHARED_BUILD} = 0 ; then
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
- else
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
- fi
+ RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
else
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} DEBUG"
- else
- RC_DEFINES=""
- fi
+ RC_DEFINES=""
fi
#--------------------------------------------------------------------
@@ -5397,7 +5378,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
-
# win/tcl.m4 doesn't set (CFLAGS)
diff --git a/win/configure.ac b/win/configure.ac
index 08f420a..3381822 100644
--- a/win/configure.ac
+++ b/win/configure.ac
@@ -332,8 +332,6 @@ fi
SC_ENABLE_SYMBOLS
-TCL_DBGX=${DBGX}
-
#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------
@@ -350,10 +348,6 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------
-TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
-TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-
eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
@@ -372,11 +366,9 @@ eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
-
-eval "DLLSUFFIX=${DLLSUFFIX}"
-eval "LIBPREFIX=${LIBPREFIX}"
-eval "LIBSUFFIX=${LIBSUFFIX}"
-eval "EXESUFFIX=${EXESUFFIX}"
+TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
@@ -388,17 +380,9 @@ CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
#--------------------------------------------------------------------
if test ${SHARED_BUILD} = 0 ; then
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
- else
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
- fi
+ RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
else
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} DEBUG"
- else
- RC_DEFINES=""
- fi
+ RC_DEFINES=""
fi
#--------------------------------------------------------------------
@@ -453,7 +437,6 @@ AC_SUBST(TCL_DLL_FILE)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)
-AC_SUBST(TCL_DBGX)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
diff --git a/win/makefile.vc b/win/makefile.vc
index c6b53d0..e3de98e 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -688,7 +688,6 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
-@TCL_DBGX@ $(SUFX)
@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
@TCL_NEEDS_EXP_FILE@
@LIBS@ $(baselibs) $(PRJ_LIBS)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index fac32ee..7536ede 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -708,7 +708,7 @@ QualifyPath(
{
char szCwd[MAX_PATH + 1];
- GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
+ GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
printf("%s\n", szCwd);
return 0;
}
diff --git a/win/rules.vc b/win/rules.vc
index 490f9c3..61df910 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -514,7 +514,7 @@ CFG_ENCODING = \"cp1252\"
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is
-# in its own source. This is the "master" copy and kept updated.
+# in its own source. It will be kept updated there.
#
# Extensions built against an installed Tcl will use the installed
# copy of Tcl's nmakehlp.c if there is one and their own version
@@ -730,11 +730,8 @@ MSVCRT = 0
!else
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
-MSVCRT = 1
-!else
-!if !$(STATIC_BUILD)
-MSVCRT = 1
!else
+!if $(STATIC_BUILD)
MSVCRT = 0
!endif
!endif
@@ -743,17 +740,12 @@ MSVCRT = 0
!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
!message *** Doing staticpkg
TCL_USE_STATIC_PACKAGES = 1
-!else
-TCL_USE_STATIC_PACKAGES = 0
!endif
!if [nmakehlp -f $(OPTS) "nothreads"]
!message *** Compile explicitly for non-threaded tcl
TCL_THREADS = 0
USE_THREAD_ALLOC= 0
-!else
-TCL_THREADS = 1
-USE_THREAD_ALLOC= 1
!endif
!if "$(TCL_MAJOR_VERSION)" == "8"
@@ -1051,7 +1043,7 @@ BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
!endif
-!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
+!if !$(DEBUG) || $(TCL_VERSION) > 86 || $(DEBUG) && $(UNCHECKED)
SUFX = $(SUFX:g=)
!endif
@@ -1677,7 +1669,7 @@ default-shell: default-setup $(PROJECT)
!ifdef RCFILE
# Note: don't use $** in below rule because there may be other dependencies
-# and only the "master" rc must be passed to the resource compiler
+# and only the "main" rc must be passed to the resource compiler
$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
$(RESCMD) $(RCDIR)\$(PROJECT).rc
@@ -1731,7 +1723,7 @@ DISABLE_IMPLICIT_RULES = 0
!if !$(DISABLE_IMPLICIT_RULES)
# Implicit rule definitions - only for building library objects. For stubs and
-# main application, the master makefile should define explicit rules.
+# main application, the makefile should define explicit rules.
{$(ROOT)}.c{$(TMP_DIR)}.obj::
$(CCPKGCMD) @<<
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 065d598..7ab2a38 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -348,7 +348,7 @@ SOURCE=..\doc\CrtObjCmd.3
# End Source File
# Begin Source File
-SOURCE=..\doc\CrtSlave.3
+SOURCE=..\doc\CrtAlias.3
# End Source File
# Begin Source File
diff --git a/win/tcl.m4 b/win/tcl.m4
index ca04f84..4824e8e 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -280,15 +280,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
fi
- #
- # eval is required to do the TCL_DBGX substitution
- #
-
- eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\""
- eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
- eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
- eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
-
eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
@@ -410,7 +401,6 @@ AC_DEFUN([SC_ENABLE_SHARED], [
# Sets to $(CFLAGS_OPTIMIZE) if false
# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true
# Sets to $(LDFLAGS_OPTIMIZE) if false
-# DBGX Debug library extension
#
#------------------------------------------------------------------------
@@ -421,7 +411,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
- DBGX=""
AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?])
AC_MSG_RESULT([no])
@@ -429,7 +418,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
else
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
- DBGX=g
if test "$tcl_ok" = "yes"; then
AC_MSG_RESULT([yes (standard debugging)])
fi
@@ -651,7 +639,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_MSG_RESULT([using static flags])
runtime=
LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
+ EXESUFFIX="s.exe"
else
# dynamic
AC_MSG_RESULT([using shared flags])
@@ -665,7 +653,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
runtime=
# Add SHLIB_LD_LIBS to the Make rule, not here.
- EXESUFFIX="\${DBGX}.exe"
+ EXESUFFIX=".exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
# Link with gcc since ld does not link to default libs like
@@ -676,9 +664,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
-Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
+ DLLSUFFIX=".dll"
+ LIBSUFFIX=".a"
+ LIBFLAGSUFFIX=""
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
@@ -750,14 +738,14 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_MSG_RESULT([using static flags])
runtime=-MT
LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
+ EXESUFFIX="s.exe"
else
# dynamic
AC_MSG_RESULT([using shared flags])
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
LIBRARIES="\${SHARED_LIBRARIES}"
- EXESUFFIX="\${DBGX}.exe"
+ EXESUFFIX=".exe"
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
@@ -769,9 +757,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
+ DLLSUFFIX=".dll"
+ LIBSUFFIX=".lib"
+ LIBFLAGSUFFIX=""
if test "$do64bit" != "no" ; then
case "$do64bit" in
@@ -1069,7 +1057,7 @@ AC_DEFUN([SC_PROG_TCLSH], [
AC_DEFUN([SC_BUILD_TCLSH], [
AC_MSG_CHECKING([for tclsh in Tcl build directory])
- BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}
+ BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}
AC_MSG_RESULT($BUILD_TCLSH)
AC_SUBST(BUILD_TCLSH)
])
diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index 5dc6833..776dcb0 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -23,9 +23,10 @@ TCL_CC='@CC@'
# -D flags for use with the C compiler.
TCL_DEFS='@DEFS@'
-# If TCL was built with debugging symbols, generated libraries contain
-# this string at the end of the library name (before the extension).
-TCL_DBGX=@TCL_DBGX@
+# TCL_DBGX used to be used to distinguish debug vs. non-debug builds.
+# This was a righteous pain so the core doesn't do that any more.
+# DEPRECATED, will be removed in Tcl 9!
+TCL_DBGX=''
# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 44067aa..420e324 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -624,15 +624,8 @@ TclpSetVariables(
*----------------------------------------------------------------------
*/
-#if defined(_WIN32)
-# define tenviron _wenviron
-# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
- (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
-#else
-# define tenviron environ
-# define tenviron2utfdstr(tenvstr, len, dstr) \
- Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
-#endif
+# define tenviron2utfdstr(string, len, dsPtr) \
+ (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))
int
TclpFindVariable(
@@ -644,7 +637,8 @@ TclpFindVariable(
* searches). */
{
int i, length, result = -1;
- const char *env, *p1, *p2;
+ const WCHAR *env;
+ const char *p1, *p2;
char *envUpper, *nameUpper;
Tcl_DString envString;
@@ -658,16 +652,17 @@ TclpFindVariable(
Tcl_UtfToUpper(nameUpper);
Tcl_DStringInit(&envString);
- for (i = 0, env = (const char *)tenviron[i];
+ for (i = 0, env = _wenviron[i];
env != NULL;
- i++, env = (const char *)tenviron[i]) {
+ i++, env = _wenviron[i]) {
/*
* Chop the env string off after the equal sign, then Convert the name
* to all upper case, so we do not have to convert all the characters
* after the equal sign.
*/
- envUpper = tenviron2utfdstr(env, -1, &envString);
+ Tcl_DStringInit(&envString);
+ envUpper = Tcl_WCharToUtfDString(env, -1, &envString);
p1 = strchr(envUpper, '=');
if (p1 == NULL) {
continue;
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 2ab4efa..7d5249d 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -84,12 +84,12 @@ Tcl_InitNotifier(void)
} else {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- TclpMasterLock();
+ TclpGlobalLock();
if (!initialized) {
initialized = 1;
InitializeCriticalSection(&notifierMutex);
}
- TclpMasterUnlock();
+ TclpGlobalUnlock();
/*
* Register Notifier window class if this is the first thread to use
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index edbdbdd..bf4553c 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -14,7 +14,6 @@
#ifndef _TCLWINPORT
#define _TCLWINPORT
-
#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT)
/* See [Bug 3354324]: file mtime sets wrong time */
# define __MINGW_USE_VC2005_COMPAT
@@ -27,7 +26,7 @@
/*
* We must specify the lower version we intend to support.
*
- * WINVER = 0x0500 means Windows 2000 and above
+ * WINVER = 0x0501 means Windows XP and above
*/
#ifndef WINVER
@@ -50,7 +49,9 @@ typedef DWORD_PTR * PDWORD_PTR;
/*
* Ask for the winsock function typedefs, also.
*/
-#define INCL_WINSOCK_API_TYPEDEFS 1
+#ifndef INCL_WINSOCK_API_TYPEDEFS
+# define INCL_WINSOCK_API_TYPEDEFS 1
+#endif
#include <winsock2.h>
#include <ws2tcpip.h>
#ifdef HAVE_WSPIAPI_H
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 87e0dc6..48b3cee 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -372,7 +372,7 @@ InitializeHostName(
Tcl_DString ds;
Tcl_DStringInit(&ds);
- if (GetComputerNameExW(ComputerNameDnsFullyQualified, wbuf, &length) != 0) {
+ if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) {
/*
* Convert string from native to UTF then change to lowercase.
*/
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 5841509..91a3010 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -13,7 +13,11 @@
# define USE_TCL_STUBS
#endif
#include "tclInt.h"
-#include "tclTomMath.h"
+#ifdef TCL_WITH_EXTERNAL_TOMMATH
+# include "tommath.h"
+#else
+# include "tclTomMath.h"
+#endif
/*
* For TestplatformChmod on Windows
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 89f2b12..abd4f84 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -22,15 +22,15 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask
#endif
/*
- * This is the master lock used to serialize access to other serialization
+ * This is the global lock used to serialize access to other serialization
* data structures.
*/
-static CRITICAL_SECTION masterLock;
+static CRITICAL_SECTION globalLock;
static int initialized = 0;
/*
- * This is the master lock used to serialize initialization and finalization
+ * This is the global lock used to serialize initialization and finalization
* of Tcl as a whole.
*/
@@ -362,7 +362,7 @@ TclpInitLock(void)
initialized = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
- InitializeCriticalSection(&masterLock);
+ InitializeCriticalSection(&globalLock);
}
EnterCriticalSection(&initLock);
}
@@ -393,7 +393,7 @@ TclpInitUnlock(void)
/*
*----------------------------------------------------------------------
*
- * TclpMasterLock
+ * TclpGlobalLock
*
* This procedure is used to grab a lock that serializes creation of
* mutexes, condition variables, and thread local storage keys.
@@ -405,13 +405,13 @@ TclpInitUnlock(void)
* None.
*
* Side effects:
- * Acquire the master mutex.
+ * Acquire the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterLock(void)
+TclpGlobalLock(void)
{
if (!initialized) {
/*
@@ -424,15 +424,15 @@ TclpMasterLock(void)
initialized = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
- InitializeCriticalSection(&masterLock);
+ InitializeCriticalSection(&globalLock);
}
- EnterCriticalSection(&masterLock);
+ EnterCriticalSection(&globalLock);
}
/*
*----------------------------------------------------------------------
*
- * TclpMasterUnlock
+ * TclpGlobalUnlock
*
* This procedure is used to release a lock that serializes creation and
* deletion of synchronization objects.
@@ -441,15 +441,15 @@ TclpMasterLock(void)
* None.
*
* Side effects:
- * Release the master mutex.
+ * Release the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterUnlock(void)
+TclpGlobalUnlock(void)
{
- LeaveCriticalSection(&masterLock);
+ LeaveCriticalSection(&globalLock);
}
/*
@@ -506,14 +506,14 @@ Tcl_GetAllocMutex(void)
void
TclFinalizeLock(void)
{
- TclpMasterLock();
+ TclpGlobalLock();
DeleteCriticalSection(&joinLock);
/*
* Destroy the critical section that we are holding!
*/
- DeleteCriticalSection(&masterLock);
+ DeleteCriticalSection(&globalLock);
initialized = 0;
#if TCL_THREADS
@@ -561,10 +561,10 @@ Tcl_MutexLock(
CRITICAL_SECTION *csPtr;
if (*mutexPtr == NULL) {
- TclpMasterLock();
+ TclpGlobalLock();
/*
- * Double inside master lock check to avoid a race.
+ * Double inside global lock check to avoid a race.
*/
if (*mutexPtr == NULL) {
@@ -573,7 +573,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
}
- TclpMasterUnlock();
+ TclpGlobalUnlock();
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
EnterCriticalSection(csPtr);
@@ -675,7 +675,7 @@ Tcl_ConditionWait(
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
- TclpMasterLock();
+ TclpGlobalLock();
/*
* Create the per-thread event and queue pointers.
@@ -689,14 +689,14 @@ Tcl_ConditionWait(
tsdPtr->flags = WIN_THREAD_RUNNING;
doExit = 1;
}
- TclpMasterUnlock();
+ TclpGlobalUnlock();
if (doExit) {
/*
* Create a per-thread exit handler to clean up the condEvent. We
- * must be careful to do this outside the Master Lock because
+ * must be careful to do this outside the Global Lock because
* Tcl_CreateThreadExitHandler uses its own ThreadSpecificData,
- * and initializing that may drop back into the Master Lock.
+ * and initializing that may drop back into the Global Lock.
*/
Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
@@ -704,7 +704,7 @@ Tcl_ConditionWait(
}
if (*condPtr == NULL) {
- TclpMasterLock();
+ TclpGlobalLock();
/*
* Initialize the per-condition queue pointers and Mutex.
@@ -718,7 +718,7 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) winCondPtr;
TclRememberCondition(condPtr);
}
- TclpMasterUnlock();
+ TclpGlobalUnlock();
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
winCondPtr = *((WinCondition **)condPtr);
@@ -896,7 +896,7 @@ FinalizeConditionEvent(
* This procedure is invoked to clean up a condition variable. This is
* only safe to call at the end of time.
*
- * This assumes the Master Lock is held.
+ * This assumes the Global Lock is held.
*
* Results:
* None.
@@ -1065,19 +1065,19 @@ TclpThreadDeleteKey(
}
void
-TclpThreadSetMasterTSD(
+TclpThreadSetGlobalTSD(
void *tsdKeyPtr,
void *ptr)
{
DWORD *key = (DWORD *)tsdKeyPtr;
if (!TlsSetValue(*key, ptr)) {
- Tcl_Panic("unable to set master TSD value");
+ Tcl_Panic("unable to set global TSD value");
}
}
void *
-TclpThreadGetMasterTSD(
+TclpThreadGetGlobalTSD(
void *tsdKeyPtr)
{
DWORD *key = (DWORD *)tsdKeyPtr;